小白求多段线打断代码

haixia2345 · 发表于 2015-11-17 23:27

打个比喻，二个长方形相交，执行LISP命令后，点其中一个长方形，则自鼠标所点处那一部分线段（相交会有二个交点）自动被打断，请知道的回复我一下，非常感谢。小弟在机械模具设计时经常要画到挂台，那里会有一段要打断然后改成虚线，我总是剪掉，然后再画一条线段，再改成虚线，特别浪费时间。只要打断的就可以了，我再把炸开跟改虚线命令加上去即可。当然如果能一起提供就更好了。不胜感谢！！！

brbright · 发表于 2015-11-18 10:27

(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)
)

lxdz443 · 发表于 2015-11-18 06:30

画个图演示一下要打断的地方。

xyp1964 · 发表于 2015-11-18 06:53

brbright · 发表于 2015-11-18 10:35

qetuop · 发表于 2015-11-18 12:09

xyp1964 发表于 2015-11-18 06:53

院长好厉害，能公布一下源码给大伙学习下吗？

ivde · 发表于 2015-11-18 12:47

用G版的API更简单

brbright · 发表于 2015-11-18 13:02

qetuop 发表于 2015-11-18 12:09
院长好厉害，能公布一下源码给大伙学习下吗？

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>")
)
)
)
)
(setq i -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>")
)
)
)
)
(setq i -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 "")
(setq LastOb (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)

(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>") 
       ) 
     ) 
    ) 
  ) 
  (setq  i -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>") 
        ) 
      ) 
    ) 
  ) 
  (setq  i -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 "") 
  (setq  LastOb   (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)

xiaolong1487 · 发表于 2015-11-19 07:44

brbright 发表于 2015-11-18 13:02
http://autocadtips1.com/2012/02/28/autolisp-subract-objects-from-a-closed-polyline/

你的错误处理函数好像没什么用！

brbright · 发表于 2015-11-19 08:32

xiaolong1487 发表于 2015-11-19 07:44
你的错误处理函数好像没什么用！

不清楚，我直接拿别人的。你可以研究一下。

账号		自动登录	找回密码
密码			注册

[机械] 小白求多段线打断代码

点评

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源