求LISP程序：多段线与直线组 Y方向延伸至与指定点的Y坐标相同

fengyu6913

求LISP程序：多段线与直线组 Y方向延伸至与指定点的Y坐标相同

guosheyang

(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 p2  pp2 p1 zmh 11)
        )
        (setq zdzb(ff pp p1 p2 pp2))
        (entmod(subst (cons zmh  zdzb) (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)
)

hubeiwdlue

http://bbs.mjtd.com/thread-183774-1-1.html
可以参考这个帖子，多段线只支持2个端点的。

guosheyang

fengyu6913

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框选 ...

多谢大佬，

xyp1964