<求助>关于把同一Lisp文件下的几个命令整合成一个可选择状态<已解决>

ㄘ丶转裑ㄧ灬 · 发表于 2011-10-23 23:57:24

本帖最后由ㄘ丶转裑ㄧ灬于 2011-10-24 14:16 编辑

 在网上载了一段打断相交直线的LSP，就是很多人都知道的breakall，下面是代码.
本人刚接触LSP的编程，额、、不到一个月，呵呵，所以现在只会修改里面的命令（别笑哈)!
下面的代码我去掉了几个命令，只留了我需要的3个，不知道算不算侵权，呵呵！

现在我想叫大家帮忙的是：
 怎么把那3个命令（BreakAll、BreakWith、BreakSelected）合并成一个命令，效果是这样的：
 命令: dd
 输入选项 [全部(A)/相对(W)/已选(S)]<全部>:
 额，不知道我表达的大家能看懂不，有什么不详细的地方大家可以提出来，谢谢！

(defun break_with (ss2brk ss2brkwith self /
cmd intpts lst masterlist
ss ssobjs onlockedlayer
ssget->vla-list list->3pair get_interpts
break_obj
)
(vl-load-com)
(defun onlockedlayer (ename / entlst)
(setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))
(= 4 (logand 4 (cdr (assoc 70 entlst))))
)
(defun ssget->vla-list (ss / i ename lst)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq lst (cons (vlax-ename->vla-object ename) lst))
)
lst
)
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)
)
)
(reverse new)
)
(defun get_interpts (obj1 obj2 / iplist)
(if (not
(vl-catch-all-error-p
(setq
iplist (vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-intersectwith obj1 obj2 acextendnone)
)
)
)
)
)
)
iplist
)
)
(defun break_obj (ent brkptlst / brkobjlst
en enttype maxparam closedobj
minparam obj obj2break p1param
p2 p2param
)
(setq obj2break ent
brkobjlst (list ent)
enttype (cdr (assoc 0 (entget ent)))
)
(foreach brkpt brkptlst
(if brkobjlst
(progn
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break brkpt)
)
)
)
(foreach obj brkobjlst
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj brkpt)
)
)
(setq obj2break obj)
)
)
)
)
)
(cond
((and (= "SPLINE" enttype)
(vlax-curve-isclosed obj2break)
)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam
obj2break
(+ p1param 0.000001)
)
)
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans p2 0 1)
)
)
((= "CIRCLE" enttype)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam
obj2break
(+ p1param 0.000001)
)
)
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans p2 0 1)
)
(setq enttype "ARC")
)
((and (= "ELLIPSE" enttype)
(vlax-curve-isclosed obj2break)
)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2param (+ p1param 0.000001)
minparam (min p1param p2param)
maxparam (max p1param p2param)
obj (vlax-ename->vla-object obj2break)
)
(vlax-put obj 'startparameter maxparam)
(vlax-put obj 'endparameter (+ minparam (* pi 2)))
)
(t
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans brkpt 0 1)
)
(if (not closedobj)
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
)
)
(if (and ss2brk ss2brkwith)
(progn
(foreach obj (ssget->vla-list ss2brk)
(if (not (onlockedlayer (vlax-vla-object->ename obj)))
(progn
(setq lst nil)
(foreach intobj (ssget->vla-list ss2brkwith)
(if (and (or self (not (equal obj intobj)))
(setq intpts (get_interpts obj intobj))
)
(setq lst (append (list->3pair intpts) lst))
)
)
(if lst
(setq masterlist
(cons (cons (vlax-vla-object->ename obj) lst)
masterlist
)
)
)
)
)
)
(if masterlist
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
)
)
)
)
)
(princ)
;-------------------------------------------打断所有直线
(defun c:breakall (/ cmd ss)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nSelect All objects to break & press enter: ")
(if (setq ss
(ssget
'((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))
)
)
(Break_with ss ss nil)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)
(defun c:BreakObject (/ cmd ss1 ss2)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nSelect single object to break: ")
(if
(and (setq
ss1 (ssget
"+.:E:S"
'((0
.
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
)
)
)
(not (redraw (ssname ss1 0) 3))
(not
(prompt
"\n*** Select object(s) to break with & press enter: ***"
)
)
(setq
ss2 (ssget
'((0
.
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
)
)
)
(not (redraw (ssname ss1 0) 4))
)
(Break_with ss1 ss2 nil)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)
;-----------------------------------用所选直线打断其他线(所选直线不打断)
(defun c:BreakWith (/ cmd ss1 ss2)
(defun ssredraw (ss mode / i num)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(redraw (ssname ss i) mode)
)
)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(prompt "\nSelect object(s) to break & press enter: ")
(if
(and (setq
ss1 (ssget
'((0
.
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
)
)
)
(not (ssredraw ss1 3))
(not
(prompt
"\n*** Select object(s) to break with & press enter: ***"
)
)
(setq
ss2 (ssget
'((0
.
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
)
)
)
(not (ssredraw ss1 4))
)
(break_with ss1 ss2 nil)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)
;------------------------有交点处全打断(只限所选直线)
(defun c:BreakSelected (/ cmd ss1 ss2)
(defun gettouching (sscros / ss lst lstb lstc objl)
(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"))
)
)
)
(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
(vl-catch-all-apply
'(lambda ()
(vlax-safearray->list
(vlax-variant-value
(vla-intersectwith y x acextendnone)
)
)
)
)
)
)
(setq lstc (cons (vlax-vla-object->ename x) lstc))
)
)
objl
)
)
lst
)
)
lstc
)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq ss1 (ssadd))
(if
(and (not
(prompt "\nSelect object(s) to break with & press enter: ")
)
(setq
ss2 (ssget
'((0
.
"LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"
)
)
)
)
(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))
)
(break_with ss2 ss1 nil)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)

(defun break_with (ss2brk        ss2brkwith   self          / 
                   cmd                intpts             lst          masterlist 
                   ss                ssobjs             onlockedlayer 
                   ssget->vla-list             list->3pair  get_interpts 
                   break_obj 
                  ) 
  (vl-load-com) 
  (defun onlockedlayer (ename / entlst) 
    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename))))) 
    (= 4 (logand 4 (cdr (assoc 70 entlst)))) 
  ) 
 
  (defun ssget->vla-list (ss / i ename lst) 
    (setq i -1) 
    (while (setq ename (ssname ss (setq i (1+ i)))) 
      (setq lst (cons (vlax-ename->vla-object ename) lst)) 
    ) 
    lst 
  ) 
 
  (defun list->3pair (old / new) 
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new) 
                 old (cdddr old) 
           ) 
    ) 
    (reverse new) 
  ) 
  (defun get_interpts (obj1 obj2 / iplist) 
    (if        (not 
          (vl-catch-all-error-p 
            (setq 
              iplist (vl-catch-all-apply 
                       'vlax-safearray->list 
                       (list 
                         (vlax-variant-value 
                           (vla-intersectwith obj1 obj2 acextendnone) 
                         ) 
                       ) 
                     ) 
            ) 
          ) 
        ) 
      iplist 
    ) 
  ) 
  (defun break_obj (ent               brkptlst          /             brkobjlst 
                    en               enttype          maxparam   closedobj 
                    minparam   obj          obj2break  p1param 
                    p2               p2param 
                   ) 
 
    (setq obj2break ent 
          brkobjlst (list ent) 
          enttype   (cdr (assoc 0 (entget ent))) 
    ) 
 
    (foreach brkpt brkptlst 
      (if brkobjlst 
        (progn 
          (if (not (numberp (vl-catch-all-apply 
                              'vlax-curve-getdistatpoint 
                              (list obj2break brkpt) 
                            ) 
                   ) 
              ) 
            (foreach obj brkobjlst 
              (if (numberp (vl-catch-all-apply 
                             'vlax-curve-getdistatpoint 
                             (list obj brkpt) 
                           ) 
                  ) 
                (setq obj2break obj) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (cond 
        ((and (= "SPLINE" enttype) 
              (vlax-curve-isclosed obj2break) 
         ) 
         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) 
               p2      (vlax-curve-getpointatparam 
                         obj2break 
                         (+ p1param 0.000001) 
                       ) 
         ) 
         (command "._break" 
                  obj2break 
                  "_non" 
                  (trans brkpt 0 1) 
                  "_non" 
                  (trans p2 0 1) 
         ) 
        ) 
        ((= "CIRCLE" enttype) 
         (setq p1param (vlax-curve-getparamatpoint obj2break brkpt) 
               p2      (vlax-curve-getpointatparam 
                         obj2break 
                         (+ p1param 0.000001) 
                       ) 
         ) 
         (command "._break" 
                  obj2break 
                  "_non" 
                  (trans brkpt 0 1) 
                  "_non" 
                  (trans p2 0 1) 
         ) 
         (setq enttype "ARC") 
        ) 
        ((and (= "ELLIPSE" enttype) 
              (vlax-curve-isclosed obj2break) 
         ) 
         (setq p1param        (vlax-curve-getparamatpoint obj2break brkpt) 
               p2param        (+ p1param 0.000001) 
               minparam        (min p1param p2param) 
               maxparam        (max p1param p2param) 
               obj        (vlax-ename->vla-object obj2break) 
         ) 
         (vlax-put obj 'startparameter maxparam) 
         (vlax-put obj 'endparameter (+ minparam (* pi 2))) 
        ) 
        (t 
         (setq closedobj (vlax-curve-isclosed obj2break)) 
         (command "._break" 
                  obj2break 
                  "_non" 
                  (trans brkpt 0 1) 
                  "_non" 
                  (trans brkpt 0 1) 
         ) 
         (if (not closedobj) 
           (setq brkobjlst (cons (entlast) brkobjlst)) 
         ) 
        ) 
      ) 
    ) 
  ) 
  (if (and ss2brk ss2brkwith) 
    (progn 
      (foreach obj (ssget->vla-list ss2brk) 
        (if (not (onlockedlayer (vlax-vla-object->ename obj))) 
          (progn 
            (setq lst nil) 
            (foreach intobj (ssget->vla-list ss2brkwith) 
              (if (and (or self (not (equal obj intobj))) 
                       (setq intpts (get_interpts obj intobj)) 
                  ) 
                (setq lst (append (list->3pair intpts) lst)) 
              ) 
            ) 
            (if        lst 
              (setq masterlist 
                     (cons (cons (vlax-vla-object->ename obj) lst) 
                           masterlist 
                     ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (if masterlist 
        (foreach obj2brk masterlist 
          (break_obj (car obj2brk) (cdr obj2brk)) 
        ) 
      ) 
    ) 
  ) 
 
) 
(princ) 
;-------------------------------------------打断所有直线 
(defun c:breakall (/ cmd ss) 
 
  (command "._undo" "_begin") 
  (setq cmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nSelect All objects to break & press enter: ") 
  (if (setq ss 
             (ssget 
               '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")) 
             ) 
      ) 
    (Break_with ss ss nil) 
  ) 
 
  (setvar "CMDECHO" cmd) 
  (command "._undo" "_end") 
  (princ) 
) 
(defun c:BreakObject (/ cmd ss1 ss2) 
 
  (command "._undo" "_begin") 
  (setq cmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nSelect single object to break: ") 
  (if 
    (and (setq 
           ss1 (ssget 
                 "+.:E:S" 
                 '((0 
                    . 
                    "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
                   ) 
                  ) 
               ) 
         ) 
         (not (redraw (ssname ss1 0) 3)) 
         (not 
           (prompt 
             "\n***  Select object(s) to break with & press enter:  ***" 
           ) 
         ) 
         (setq 
           ss2 (ssget 
                 '((0 
                    . 
                    "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
                   ) 
                  ) 
               ) 
         ) 
         (not (redraw (ssname ss1 0) 4)) 
    ) 
     (Break_with ss1 ss2 nil) 
  ) 
 
  (setvar "CMDECHO" cmd) 
  (command "._undo" "_end") 
  (princ) 
) 
 
;-----------------------------------用所选直线打断其他线(所选直线不打断) 
(defun c:BreakWith (/ cmd ss1 ss2) 
  (defun ssredraw (ss mode / i num) 
    (setq i -1) 
    (while (setq ename (ssname ss (setq i (1+ i)))) 
      (redraw (ssname ss i) mode) 
    ) 
  ) 
  (command "._undo" "_begin") 
  (setq cmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (prompt "\nSelect object(s) to break & press enter: ") 
  (if 
    (and (setq 
           ss1 (ssget 
                 '((0 
                    . 
                    "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
                   ) 
                  ) 
               ) 
         ) 
         (not (ssredraw ss1 3)) 
         (not 
           (prompt 
             "\n***  Select object(s) to break with & press enter:  ***" 
           ) 
         ) 
         (setq 
           ss2 (ssget 
                 '((0 
                    . 
                    "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
                   ) 
                  ) 
               ) 
         ) 
         (not (ssredraw ss1 4)) 
    ) 
     (break_with ss1 ss2 nil) 
  ) 
 
  (setvar "CMDECHO" cmd) 
  (command "._undo" "_end") 
  (princ) 
) 
 
;------------------------有交点处全打断(只限所选直线) 
 
(defun c:BreakSelected (/ cmd ss1 ss2) 
  (defun gettouching (sscros / ss lst lstb lstc objl) 
    (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")) 
           ) 
         ) 
      ) 
      (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 
                        (vl-catch-all-apply 
                          '(lambda () 
                             (vlax-safearray->list 
                               (vlax-variant-value 
                                 (vla-intersectwith y x acextendnone) 
                               ) 
                             ) 
                           ) 
                        ) 
                      ) 
                    ) 
                  (setq lstc (cons (vlax-vla-object->ename x) lstc)) 
                ) 
              ) 
             objl 
           ) 
         ) 
        lst 
      ) 
    ) 
    lstc 
  ) 
 
  (command "._undo" "_begin") 
  (setq cmd (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (setq ss1 (ssadd)) 
  (if 
    (and (not 
           (prompt "\nSelect object(s) to break with & press enter: ") 
         ) 
         (setq 
           ss2 (ssget 
                 '((0 
                    . 
                    "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE" 
                   ) 
                  ) 
               ) 
         ) 
         (mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2)) 
    ) 
     (break_with ss2 ss1 nil) 
  ) 
 
  (setvar "CMDECHO" cmd) 
  (command "._undo" "_end") 
  (princ) 
)

ㄘ丶转裑ㄧ灬 · 发表于 2011-10-24 09:41:27

嗯，两条都没有，所以不算侵权，呵呵！

有谁能解决不，可能对高手来说这比较简单，但我真的不会、、、

Gu_xl · 发表于 2011-10-24 13:12:49

(defun c:dd(/ kd)
(initget 7 "W A S ")
(setq kd (getkword "\n输入选项[全部<A>/相对<W>/已选<S>]<全部>:"))
(cond ((= "W" kd) (c:BreakWith))
((= "S" kd) (c:BreakSelected))
(t (c:breakall ))
)
(princ)
)

ㄘ丶转裑ㄧ灬 · 发表于 2011-10-24 13:44:53

Gu_xl 发表于 2011-10-24 13:12

果然是版主厉害！
这样就省事多了，不用多去记几个命令，非常感谢！
嗯，继续学习、、、、

maiko · 发表于 2011-10-24 17:31:53

G版是我最佩服的达人

,俺啥时才能到达这个境界

zhangcan0515 · 发表于 2020-8-25 18:23:44

谢谢G老大的代码，修改了一下用了。

magicheno · 发表于 2020-8-25 18:39:46

谢谢G老大的代码，原来还可以这么玩，我都是一个一个用

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

<求助>关于把同一Lisp文件下的几个命令整合成一个可选择状态<已解决>

点评

相关帖子

点评

评分