本帖最后由 millermin 于 -4-12 09:08 编辑
奉献两个打断程序。一直线打断一组线。这个好办，一个循环就完成了。另一个是一组线打断一根直线。这个有点麻烦，因为断第一点以后，原来的目标变成了两个，那么原来的变量名就不能再用，程序无法继续。经过观察，找到解决办法，请各位行家大力斧正。为提高操作速度，我特意分成两个程序，只要记住两个程序名就可以节省了操作过程中的选项。
1. 一断多：
(defun c:bpm (/ pt )
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setq bl (car (entsel "\nCHOOSE A LINE TO BE CUT:")))
(setq bl-v (vlax-ename->vla-object bl))
(prompt "\nCHOOSE CUTTING LINES:")
(setq cutln-s(ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,LWPOLYLINE,SPLINE"))))
(setq m 0)
(setq n 0)
( while (< m (sslength cutln-s))
(setq cutln(ssname cutln-s m))
(setq cutln-v (vlax-ename->vla-object cutln))
(if (and (setq point-v (vla-intersectwith bl-v cutln-v acExtendNone))
(setq point (vlax-variant-value point-v))
(> (vlax-safearray-get-u-bound point 1) 0)
)
(progn
(setq point (vlax-safearray->list (vlax-variant-value point-v)))
(COMMAND "_break" cutln point "@")
;(setq pt(append pt (list point)))
(setq m (+ m 1))
) ; end progn
(setq m (+ m 1))
) ; end if
) ; end while
(princ)
)
2. 多断一。
(defun c:bps (/ pt )
(vl-load-com)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setq bl (car (entsel "\nCHOOSE A LINE TO BE CUT:")))
(setq bl-v (vlax-ename->vla-object bl))
(prompt "\nCHOOSE CUTTING LINES:")
(setq cutln-s(ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,LWPOLYLINE,SPLINE,INSERT"))))
(setq m 0)
(setq n 0)
( while (< m (sslength cutln-s))
(setq cutln(ssname cutln-s m))
(setq cutln-v (vlax-ename->vla-object cutln))
(if (and (setq point-v (vla-intersectwith bl-v cutln-v acExtendNone))
(setq point (vlax-variant-value point-v))
(> (vlax-safearray-get-u-bound point 1) 0)
)
(progn
(setq point (vlax-safearray->list (vlax-variant-value point-v)))
(if (> (length point) 3)
(progn
(setq i 0)
(repeat (/ (length point) 3)
(setq point-i(list (nth i point) (nth (+ i 1) point) (nth (+ i 2) point)))
(setq pt(append pt (list point-i)))
(setq i (+ i 3))
) ; end repeat
) ; end progn
) ; end if >
(setq pt(append pt (list point)))
(setq m (+ m 1))
) ; end progn
(setq m (+ m 1))
) ; end if
) ; end while
(setq blst(vlax-curve-getstartpoint bl-v)
blend(vlax-curve-getendpoint bl-v))
(if (= (cadr blst) (cadr blend))
(progn
(if (> (car blst) (car blend))
(setq pt
(vl-sort pt
(function (lambda (e1 e2) (> (car e1) (car e2))))
)
)
(setq pt
(vl-sort pt
(function (lambda (e1 e2) (< (car e1) (car e2))))
)
)
) ; end if (>
) ; end progn
(progn
(if (> (cadr blst) (cadr blend))
(setq pt
(vl-sort pt
(function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
)
)
(setq pt
(vl-sort pt
(function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
)
)
)
); end progn
) ; end (=
(command "_break" bl (nth 0 pt) "@")
(vl-remove (nth 0 pt) pt)
(foreach x pt
(command "_break" (entlast) "non" x "@")
)
(princ)
)
cad墙线打断lisp_两个打断程序 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 程序 - Powered by Discuz!...
