如下生成中线的程序，如何修改，使得生成中线后程序不自动停止，可以继续选线生成
如下生成中线的程序，如何修改，使得生成中线后程序不自动停止，可以继续选线生成中线(defun c:SCZX( / e1 e2 ent1 ent2pt1 pt2 ssl)
(setq ssL (ss->LST (ssget '((0 . "LINE")))))
(while (setqent1 (car ssl))
(setq pt1 (cdr (assoc 10 (entget ent1))))
(setq pt2 (cdr (assoc 11 (entget ent1))))
(setq ssl (cdr ssl))
(setq ent2 (last (vl-sort ssl (function (lambda (e1 e2) (> (distance pt1 (vlax-curve-getClosestPointTo e1 pt1)) (distance pt1 (vlax-curve-getClosestPointTo e2 pt1)) ))))))
(setq ssl (vl-remove ent2 ssl))
(center-lineent1 ent2 )
)
)
(defun ss->LST ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
(defun center-line (x1 x2 /m1 m2 pt1 pt2 pt3 pt4)
(setq pt1 (cdr (assoc 10 (entget x1)))
pt2 (cdr (assoc 11 (entget x1)))
pt3 (cdr (assoc 10 (entget x2)))
pt4 (cdr (assoc 11 (entget x2)))
)
(if (inters pt1 pt4 pt2 pt3)
(progn (setq m1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt1 pt3)
m2 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt2 pt4))
)
(progn (setq m1 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt1 pt4)
m2 (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) pt2 pt3))
))
(entmakex (list (cons 0 "LINE")(cons 10 m1)(cons 62 1)(cons 8 "中心线")(cons 11 m2)))
)
加个while就好
可能不是最好的方法 不过能实现
(defun c:SCZX( / aa e1 e2 ent1 ent2pt1 pt2 ssl)
(setq aa (ssget '((0 . "LINE"))))
(while aa
(setq ssL (ss->LST aa))
(while (setqent1 (car ssl))
(setq pt1 (cdr (assoc 10 (entget ent1))))
(setq pt2 (cdr (assoc 11 (entget ent1))))
(setq ssl (cdr ssl))
(setq ent2 (last (vl-sort ssl (function (lambda (e1 e2) (> (distance pt1 (vlax-curve-getClosestPointTo e1 pt1)) (distance pt1 (vlax-curve-getClosestPointTo e2 pt1)) ))))))
(setq ssl (vl-remove ent2 ssl))
(center-lineent1 ent2 )
)
(princ "\n 继续选择:")
(setq aa (ssget '((0 . "LINE"))))
)
(print)
)
页:
[1]