|
Тема |
Re: ИЗЧИСЛЯВАНЕ И ИЗПИСВАНЕ ДЪЛЖИНИ [re: onzi] |
|
Автор | StSt (Нерегистриран) | |
Публикувано | 10.08.06 09:22 |
|
|
Вижда ми се прекалино сложно да вадиш дължините в Excel, да ги сумираш там и да ги връщаш отново в ACAD с Copy/Paste. Предлагам ти програмка, която изчислява дължините на линии, полилинии, сплайнове и дъги (предварително избрани) и прави МТЕХТ с описани по редове дължините на всички отделни групи примитиви, броя им и общата дължина.
Запиши я като *.LSP файл, зареди я с Tools/Load Application
(sp-long-type)
;сумира дължините на избрани елементи и ги описва
(defun SUM-LONG (/ i sp nab en VL-EN type-en )
(IF (SETQ
I 0
SP NIL
NAB (SSGET)
)
(PROGN
(VL-LOAD-COM)
(REPEAT (SSLENGTH NAB)
(SETQ EN (SSNAME NAB I)
I(1+ I)
VL-EN(vlax-ename->vla-object EN)
type-en (cdr(ASSOC 0 (entget en)))
);SETQ
(IF
(or
(= "LINE" type-en)
(= "LWPOLYLINE" type-en)
(= "ARC" type-en)
(= "SPLINE" type-en)
);or
(SETQ
LONG(vlax-curve-getDistAtParam VL-EN(vlax-curve-getEndParam VL-EN))
SP (APPEND SP (LIST (CONS EN LONG)))
);setq
);if LINE LWPOLYLINE ARC
);REPEAT
);PROGN
);IF NAB
sp
);SUM-LONG
;вади списък на дължините по тип на обекта от набора
(defun sp-long-type ( / sp sp-obj nn obj obj-line )
(if (setq sp (SUM-LONG))
(PROGN
(setq sp-obj nil)
(FOREACH nn sp
(setq obj (cdr(ASSOC 0 (entget (car nn)))))
(if (not (ASSOC obj sp-obj))
(setq sp-obj (APPEND sp-obj (list (list obj 0 0))))
);if
);FOREACH
(FOREACH nn sp
(setq obj (cdr(ASSOC 0 (entget (car nn))))
obj-line (ASSOC obj sp-obj)
obj-line (list (car obj-line)
(+ (nth 1 obj-line)(cdr nn))
(1+ (nth 2 obj-line)))
sp-obj (SUBST obj-line (ASSOC obj sp-obj)sp-obj)
);setq
);FOREACH
);PROGN
);if sp
(if (setq pti (getpoint "\nStart point of text: "))
(text-create sp-obj pti)
);if pti
sp-obj
);sp-long-type
;изписва текст със име, дължина и брой
(defun text-create (sp pti / txt nn all-long all-num )
(if (and sp
pti
);and
(PROGN
(setq txt "" all-long 0.0 all-num 0)
(FOREACH nn sp
(setq txt (strcat txt
(substr(strcat (nth 0 nn) " ")1 20)
(substr(strcat (rtos (nth 1 nn)2 2)" ") 1 10)
(substr(strcat (rtos (nth 2 nn)2 0)" ") 1 10)
"\\P")
all-long (+ all-long (nth 1 nn))
all-num (+ all-num (nth 2 nn)))
);FOREACH
(setq txt (strcat txt(substr(strcat " ОБЩО" " ")1 20)
(substr(strcat(rtos all-long 2 2)" ") 1 10)
(substr(strcat(rtos all-num 2 0)" ") 1 10)))
(COMMAND "mtext" pti (MAPCAR '+ pti (list (* (getvar "textsize")40.0) 10)) txt "")
);PROGN
);if sp
);text-create
Нарочно съм отделил функциите, защото на базата на тях може да се направят и други програми (например да се вадят дължините по слоеве, цвят и т.п.)
|
| |
|
|
|