求LISP程序：多段线与直线组 Y方向延伸至与指定点的Y坐标相同
求LISP程序：多段线与直线组 Y方向延伸至与指定点的Y坐标相同(defun c:tt(/ CD CZ DERD DSDERD DYD ENT I LST LSZ P P1 P2 PP PP2 SS ZDD ZDZB ZMH)
(prompt "\n框选线")
(setq ss(ssget))
(setq p(getpoint))
(defun ff(pp p1 p2 pp2)
(setq cz(abs(-(cadr pp) (cadr p))))
(if(/= 0 (setq lsz(-(car p1)(car p2))))
(setq cd(abs(/ cz (sin(atan(/(-(cadr p1)(cadr p2)) (-(car p1)(car p2))))))))
(setq cd cz)
)
(setq zdzb(polar pp (angle pp2 pp) cd))
)
(repeat(setq i(sslength ss))
(if(= "LINE"(cdr(assoc 0(SETQ ENT(entget(ssname ss(setq i(1- i))))))))
(progn
(SETQ P1(cdr(assoc 10 ENT)))
(SETQ P2 (cdr(assoc 11 ENT)))
(if(<(cadr p1)(cadr p2))
(setq pp p1 pp2 p2 zmh 10)
(setq pp p2pp2 p1 zmh 11)
)
(setq zdzb(ff pp p1 p2 pp2))
(entmod(subst (cons zmhzdzb) (cons zmh pp) ent ) )
)
(progn
(setq lst(mapcar'cdr(vl-remove-if-not '(lambda(x)(= 10(car x))) ent)))
(setq dyd(car lst))
(setq derd(cadr lst))
(setq zdd(last lst))
(setq dsderd(cadr(reverse lst)))
(setq zdzb(ff dyd dyd derd derd))
(entmod(subst (cons 10 zdzb) (cons 10 dyd) ent ) )
(setq zdzb(ff zdd zdd dsderd dsderd))
(entmod(subst (cons 10 zdzb) (cons 10 zdd) (entget(cdr(assoc -1 ent))) ) )
)
)
)
(princ)
) http://bbs.mjtd.com/thread-183774-1-1.html
可以参考这个帖子，多段线只支持2个端点的。
guosheyang 发表于 2024-5-17 08:54
(defun c:tt(/ CD CZ DERD DSDERD DYD ENT I LST LSZ P P1 P2 PP PP2 SS ZDD ZDZB ZMH)
(prompt "\n框选 ...
多谢大佬，
页:
[1]