<求助>关于把同一Lisp文件下的几个命令整合成一个可选择状态<已解决>
本帖最后由 ㄘ丶转裑ㄧ灬 于 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->3pairget_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 obj2breakp1param
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 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)
)
Gu_xl 发表于 2011-10-24 13:12 static/image/common/back.gif
果然是版主厉害！
这样就省事多了，不用多去记几个命令，非常感谢！
嗯，继续学习、、、、 G版是我最佩服的达人,俺啥时才能到达这个境界 谢谢G老大的代码，修改了一下用了。
谢谢G老大的代码，原来还可以这么玩，我都是一个一个用
页:
[1]