单触并断开int
你好单触并打断相交线/多段线
我试着用这个来创作，但它似乎不正确
(setq epoly(entsel))
(setq PIKPT (cadr EPOLY))
(setqENXT (entnext (car EPOLY)))
(setq LST (entget ENXT))
(setq P1 (cdr(assoc 10 LST)))
(setq ENXT (entnext ENXT))
(setq LST (entget ENXT))
(setq P2 (cdr(assoc 10 LST)))
(command "break" p1 p1)
(command "break" p2 p2)
我不确定我是否完全理解您的草图，但我相信使用内置命令TRIM可以很容易地解决这个问题。只需在第一个提示器（切割边缘选择）处按，然后选择要删除的零件。 你好
我不想删除或删除拾取的线，我只想打断点，所以以后我可以将保留的线更改为隐藏或更改颜色，如果使用trim命令，拾取的线将消失 您好，nalsur8，请尝试以下代码：
(DEFUN C:B1 ()
(PROMPT "\nBreak Point")
(TERPRI)
(setq obj nil)
(while (null obj)
(setq obj (entsel "\nSelect object to break: "))
)
(redraw (car obj) 3)
(initget 1)
(setq point (getpoint "\nBreak point : "))
(COMMAND "_.BREAK" obj "_F" point point)
(PRINC)
)
对不起，我的英语很差，我来自哥斯达黎加。
当做 在这里，我修改了CAB的代码。。。看看这是否能帮到你。。。
;;;=====================[ BreakObject.lsp ]=============================
;;; Author: Copyright© 2006-2012 Charles Alan Butler
;;; Contact @www.TheSwamp.org
;;; http://www.theswamp.org/index.php?topic=10370.0
;;; Version:2.2July 28, 2012
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY.ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;;You are hereby granted permission to use, copy and modify this ;
;;;software without charge, provided you do so exclusively for ;
;;;your own use or for use by others in your organization in the ;
;;;performance of their normal duties, and provided further that ;
;;;the above copyright notice appears in all copies and both that ;
;;;copyright notice and the limited warranty and restricted rights ;
;;;notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun gn ( l n / f )
(defun f ( a b )
(if (and a (< 0 b))
(cons (car a) (f (setq l (cdr a)) (1- b)))
)
)
(if l (cons (f l n) (gn l n)))
)
(defun getcltouching (sscros pt / ss lst lstb lstc objl intpt intpts)
(and
(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
objl (mapcar 'vlax-ename->vla-object lstb)
)
(setq
ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(ssdel (ssname sscros 0) ss)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(if (not
(vl-catch-all-error-p
(setq intpt (vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith y x acextendnone)
)))))))
(progn
(setq intpts (gn intpt 3))
(foreach ipt intpts
(setq lstc (cons (cons (vlax-vla-object->ename x) (list ipt)) lstc))
)
)
)
) objl)
) lst)
)
(setq lstc (vl-sort lstc '(lambda (a b) (< (distance pt (cadr a)) (distance pt (cadr b))))))
(setq intpts (list (cadar lstc) (cadadr lstc)))
intpts
)
(defun c:B2 (/ cmd ss1 ss2 pt touch) (vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss1 (ssadd))
(if (and (not (prompt "\nSelect object to break with touching & press enter: "))
(setq ss2 (ssget "_+.:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(setq pt (cadr(cadddr(car (ssnamex ss2 0)))))
(setq touch (getcltouching ss2 pt))
)
(progn
(command "_.break" pt "F" (car touch) (car touch))
(command "_.break" pt "F" (cadr touch) (cadr touch))
)
)
(setvar "CMDECHO" cmd)
(command "_.undo" "_end")
(princ)
)
(prompt "\nEnter B2 to run.")
(princ)
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;; E n d O f F i l e I f y o u A r e H e r e
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
M.R。
B2.LSP 很抱歉我更新得太晚；代码更改-我认为现在它适合您的需要。。。
M、 R。 Alenjandros85，
谢谢你的代码，它也很有用。。但这不是我的意思
marko_ribar，
感谢代码，这就是我的意思，再次感谢修改代码
为了我 看来你的问题已经解决了，
但你的问题让我想起了Lynn Allen的一个好建议
关于加快你的中断命令。我已经实现了一个，我非常喜欢。
这将使您能够创建一个断点，该断点的位置是指定的
根据第一次单击的位置，完成。
谢谢Lynn！ 试试这个：它可以让你选择一条线，并询问你的断点。Osnap在交点处自动设置
(defun C:BKI (/ ln pt1) ;;break at intersection
(setq osm (getvar 'osmode))
(setq cmd1 (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setvar 'osmode 32)
(setq ln (entsel "\nChoose Line to Break..."))
(setq pt1 (getpoint "\nPick Break Point.. "))
(command "break" ln "f" pt1 "@")
(setvar 'osmode osm)
(setvar 'cmdecho cmd1)
(princ)
)
抱歉，再修改一次：
;;;=====================[ BreakObject.lsp ]=============================
;;; Author: Copyright© 2006-2012 Charles Alan Butler
;;; Contact @www.TheSwamp.org
;;; http://www.theswamp.org/index.php?topic=10370.0
;;; Version:2.2July 28, 2012
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY.ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;;You are hereby granted permission to use, copy and modify this ;
;;;software without charge, provided you do so exclusively for ;
;;;your own use or for use by others in your organization in the ;
;;;performance of their normal duties, and provided further that ;
;;;the above copyright notice appears in all copies and both that ;
;;;copyright notice and the limited warranty and restricted rights ;
;;;notice below appear in all supporting documentation. ;
;;;=====================================================================
(defun prelst ( l i / n r )
(while (and (setq n (car l)) (not (equal n i 1e-))
(setq r (cons n r) l (cdr l))
)
(reverse r)
)
(defun sufflst ( l i / n r c )
(setq l (reverse l) c (length l))
(while (and (setq n (car l)) (not (equal n i 1e-))
(setq r (cons n r) l (cdr l))
)
(if (/= (length r) c) r)
)
(defun gn ( l n / f )
(defun f ( a b )
(if (and a (< 0 b))
(cons (car a) (f (setq l (cdr a)) (1- b)))
)
)
(if l (cons (f l n) (gn l n)))
)
(defun getcltouching (sscros pt / ss lst lstb lstc objl intpt intpt1 intpt2 intpts)
(and
(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))
objl (mapcar 'vlax-ename->vla-object lstb)
)
(setq
ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")
(cons 410 (getvar "ctab"))))
)
(ssdel (ssname sscros 0) ss)
(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
(setq lst (mapcar 'vlax-ename->vla-object lst))
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(if (not
(vl-catch-all-error-p
(setq intpt (vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith y x acextendnone)
)))))))
(progn
(setq intpts (gn intpt 3))
(foreach ipt intpts
(setq lstc (cons (cons (vlax-curve-getparamatpoint y ipt) (list ipt)) lstc))
)
)
)
) objl)
) lst)
)
(setq lstc (cons (cons (vlax-curve-getparamatpoint (car objl) (setq pt (vlax-curve-getclosestpointto (car objl) pt))) (list pt)) lstc))
(setq lstc (vl-sort lstc '(lambda (a b) (< (car a) (car b)))))
(setq lstc (mapcar 'cadr lstc))
(setq intpt1 (last (prelst lstc pt)))
(setq intpt2 (car (sufflst lstc pt)))
(setq intpts (list intpt1 intpt2))
intpts
)
(defun c:B2 (/ cmd ss1 ss2 pt touch) (vl-load-com)
(command "_.undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss1 (ssadd))
(if (and (not (prompt "\nSelect object to break with touching"))
(setq ss2 (ssget "_+.:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(setq pt (cadr(cadddr(car (ssnamex ss2 0)))))
(setq pt (vlax-curve-getclosestpointto (ssname ss2 0) pt))
(setq touch (getcltouching ss2 pt))
)
(progn
(command "_.break" (car (nentselp pt)) (car touch) (car touch))
(command "_.break" (car (nentselp pt)) (cadr touch) (cadr touch))
)
)
(setvar "CMDECHO" cmd)
(command "_.undo" "_end")
(princ)
)
(prompt "\nEnter B2 to run.")
(princ)
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;; E n d O f F i l e I f y o u A r e H e r e
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
M.R。
B2.LSP
页:
[1]
2