Тема: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.
; Программка рассчитывает длину трассы, состоящей из
; отрезков и дуг. Трасса может иметь разветвления. В
; качестве параметра указывается точность сочленения
; элементов трассы.
; Возвращает длину трассы и количество элементов.
; Подъсвечивает обсчитанную трассу. Можно также
; использовать для поиска неточности соединения элементов
; трассы.
; Автор: Борис Глумов
(defun trassa(tch / prim1 dl)
(setvar"cmdecho"0)(command"_regen")(setvar"cmdecho"1)
(while(not(setq prim1(car(entsel"Укажите любой элемент трассы: \n")))))
(if(raschkoord prim1 0)
(progn
(setvar"cmdecho"0)(command"_ZOOM""_E")
(setq dl(dlina(append(uzel prim1(raschkoord prim1 0)tch)(cdr(uzel prim1(raschkoord prim1 1)tch)))))
(command"_ZOOM""_P")(setvar"cmdecho"1)
dl
)
(progn(princ"Это не отрезок и не дуга!")(princ))
)
)
(defun raschkoord(prim1 p / tipprim)
(setq tipprim(cdr(assoc 0(entget prim1))))
(cond
((= tipprim"LINE")(cdr(assoc(+ 10 p)(entget prim1))))
((= tipprim"ARC")
(polar(cdr(assoc 10(entget prim1)))(cdr(assoc(+ 50 p)(entget prim1)))(cdr(assoc 40(entget prim1))))
)
)
)
(defun memb(mb sp1 / ind)
(foreach p sp1
(if(eq mb(car p))(setq ind T))
)
ind
)
(defun dlina(sp / pr tippr sumdl i)
(setq i 0 sumdl 0)
(if sp
(while(setq pr(car(nth i sp)))
(setq tippr(cdr(assoc 0 (entget pr)))i(1+ i))
(setq sumdl
(+ sumdl
(cond
((= tippr"LINE")(distance(cdr(assoc 10(entget pr)))(cdr(assoc 11(entget pr)))))
((= tippr"ARC")(*(abs(-(cdr(assoc 50(entget pr)))(cdr(assoc 51(entget pr)))))(cdr(assoc 40(entget pr)))))
)
)
)
)
)
(foreach p sp(redraw(car p)3))
(list sumdl(length sp))
)
(defun uzel(prim1 koord tch / kon1 koord1 n i pr lay sp)
(setq sp(list(list prim1 koord))i 0 lay(cdr(assoc 8(entget prim1))))
(while(setq pr(car(nth i sp)))
(setq koord1(raschkoord pr 0))
(if(equal(car(cdr(nth i sp)))koord1 tch)(setq koord1(raschkoord pr 1)))
(setq kon1
(ssget"_C"
(list(-(car koord1)tch)(-(cadr koord1)tch))
(list(+(car koord1)tch)(+(cadr koord1)tch))
(list(cons 0"LINE,ARC")(cons 8 lay))
) n 0
)
(repeat(sslength kon1)
(if
(and
(or(equal(raschkoord(ssname kon1 n)1)koord1 tch)(equal(raschkoord(ssname kon1 n)0)koord1 tch))
(not(memb(ssname kon1 n)sp))
(not(equal(cdr(assoc 10(entget(ssname kon1 n))))(cdr(assoc 11(entget(ssname kon1 n))))tch))
)
(setq sp(append sp(list(list(ssname kon1 n)koord1))))
)
(setq n(1+ n))
)
(setq kon1 nil i(1+ i))
)
sp
)