小白求多段线打断代码
打个比喻，二个长方形相交，执行LISP命令后，点其中一个长方形，则自鼠标所点处那一部分线段（相交会有二个交点）自动被打断，请知道的回复我一下，非常感谢。小弟在机械模具设计时经常要画到挂台，那里会有一段要打断然后改成虚线，我总是剪掉，然后再画一条线段，再改成虚线，特别浪费时间。只要打断的就可以了，我再把炸开跟改虚线命令加上去即可。当然如果能一起提供就更好了。不胜感谢！！！(defun br_break_lines_at_dot ()
(setvar "cmdecho" 0)
(setq t_ent_1 (car (entsel)))
(setq t_point_1 (getpoint "point to break"))
(setq d_osmode_1 (getvar "osmode"))
(setvar "osmode" 0)
(command "_.break" t_ent_1 t_point_1 t_point_1)
(setvar "osmode" d_osmode_1)
(br_break_lines_at_dot)
)
(defun c:brd()
(br_break_lines_at_dot)
) 画个图演示一下要打断的地方。
xyp1964 发表于 2015-11-18 06:53 static/image/common/back.gif
院长好厉害，能公布一下源码给大伙学习下吗？ 用G版的API更简单 qetuop 发表于 2015-11-18 12:09 static/image/common/back.gif
院长好厉害，能公布一下源码给大伙学习下吗？
http://autocadtips1.com/2012/02/28/autolisp-subract-objects-from-a-closed-polyline/
(defun c:PLSUB ()
(princ "\n Subtract Polylines")
(princ "\n First selected object must be a Polyline")
(setq *error* *myerror*)
(SD1028)
(princ "\n Select Objects subtract from :")
(setq ObjSet nil)
(while (= ObjSet nil)
(setq ObjSet (ssget'((-4 . "<OR")
(0 . "LWPOLYLINE")
(0 . "ELLIPSE")
(0 . "CIRCLE")
(0 . "POLYLINE")
(0 . "LINE")
(0 . "ARC")
(-4 . "OR>")
)
)
)
)
(setqi -1
ObjNameL1 nil
)
(repeat (setq m (sslength ObjSet))
(setq ObjNameL1 (cons (ssname ObjSet (setq i (1+ i))) ObjNameL1))
)
(princ "\n Select Objects subtract :")
(setq ObjSet2 nil)
(while (= ObjSet2 nil)
(setq ObjSet2 (ssget '((-4 . "<OR")
(0 . "LWPOLYLINE")
(0 . "ELLIPSE")
(0 . "CIRCLE")
(0 . "POLYLINE")
(0 . "LINE")
(0 . "ARC")
(-4 . "OR>")
)
)
)
)
(setqi -1
ObjNameL2 nil
)
(repeat (setq m (sslength ObjSet2))
(setq ObjNameL2 (cons (ssname ObjSet2 (setq i (1+ i))) ObjNameL2))
)
;region?
(setq MadeObjL1 (Procedure_1707 ObjNameL1))
(setq MadeObjL2 (Procedure_1707 ObjNameL2))
(Procedure_1707_2 MadeObjL1 MadeObjL2) ;SUBTRACT
(SD2056)
(setq *error* nil)
(princ)
)
;*********;SUBTRACT
(defun Procedure_1707_2(MadeObjL1 MadeObjL2 /)
(command ".SUBTRACT")
(mapcar 'command MadeObjL1)
(command "")
(mapcar 'command MadeObjL2)
(command "")
(setqLastOb (entlast)
MadeObjL nil
)
(command ".EXPLODE" LastOb)
(while (setq LastOb (entnext LastOb))
(setq MadeObjL (cons LastOb MadeObjL))
)
(command ".PEDIT" "M")
(mapcar 'command MadeObjL)
(command "" "Y" "J" "0.000" "")
)
;*********;Region
(defun Procedure_1707 (ObjL /)
(setq LastOb (entlast))
(command ".region")
(mapcar 'command ObjL)
(command "")
(while (setq LastOb (entnext LastOb))
(setq MadeObjL (cons LastOb MadeObjL))
)
MadeObjL
)
;
(defun SD1028 ()
(setq OldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "undo" "be")
(setq OldOsmode (getvar "OSMODE"))
(setq OldLayer (getvar "CLAYER"))
(setq OldLType (getvar "CeLType"))
(setq OldCeLWeight (getvar "CeLWeight"))
(setq OldColor (getvar "CeColor"))
(setq OldOrtho (getvar "ORTHOMODE"))
(setq OldDStyle (getvar "DIMSTYLE"))
(setq OldExpert (getvar "Expert"))
(setvar "EXPERT" 0)
(princ)
)
;********************************
(defun SD2056 ()
(setvar "OSMODE" OldOsmode)
(command "undo" "end")
(setvar "CLAYER" OldLayer)
(setvar "CeLType" OldLType)
(setvar "CeLWeight" OldCeLWeight)
(setvar "CeColor" OldColor)
(setvar "ORTHOMODE" OldOrtho)
(setvar "Expert" OldExpert)
(if (and (/= (getvar "DIMSTYLE") OldDStyle)
(tblsearch "DIMSTYLE" OldDStyle)
)
(command "-dimstyle" "Restore" OldDStyle)
)
(setvar "CMDECHO" OldCmdEcho)
(princ)
)
;********************************
(defun *myerror* (msg)
(setq *error* nil)
(SD2056)
(princ "\n Error Cancelled")
(princ)
)
(princ "\n Command Name: PLSUB to Subtract Polylines\n")
(princ) brbright 发表于 2015-11-18 13:02 static/image/common/back.gif
http://autocadtips1.com/2012/02/28/autolisp-subract-objects-from-a-closed-polyline/
你的错误处理函数好像没什么用！ xiaolong1487 发表于 2015-11-19 07:44 static/image/common/back.gif
你的错误处理函数好像没什么用！
不清楚，我直接拿别人的。你可以研究一下。
页:
[1]