求助CAD04以下框选剪切lsp，如何选块内单个线作剪切边

wowan1314

如题！ 如何实现把块内单个线作为剪切边！！？  有办法吗！
;;;==================================================

=========
;;;功能：可以点选和框选的修剪和延伸命令
;;;原创ZML84，由langjs修改于2009-05-07
;;;==================================================

=========
(defun c:kxjq () (trim&extend T)  )
(defun c:kxys () (trim&extend nil) )
(defun trim&extend (cmd / S1 S2 PT1 PT2 CMDECHO_OLD I

XX  zhuj1)
   (if cmd
      (setq cmd "_.trim"  zhuj1  "\n选择剪切边,或:<选

择全部>:"  zhuj2    "\n选择要修剪的对象，或 [投影(P)/

边(E)/放弃(U)]:" )
      (setq cmd "_.extend"  zhuj1  "\n选择边界的边,或

:<选择全部>:"  zhuj2   "\n选择要延伸的对象，或 [投影

(P)/边(E)/放弃(U)]:" )
   )
   (defun error (x) (error_end))
   (defun error_end ()
      (liangxian s1 4 )
      (setvar "osmode" snap) 打开捕捉
      (if cm (setvar "cmdecho" cm))
      (if os (setvar "osmode" os))
      (setq *error* olderr)
   )
   (setq olderr *error* *error* error)
   (setq CMDECHO_OLD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (setq liangx   1)
   (princ zhuj1)
   ;;若没有选取边界，就将全部对象作为边界
   (setvar "nomutt" 1)
   (if (setq S1 (ssget))
      ()
      (progn
         (setq S1 (ssget "all"))
         (setq liangx   0)
      )
   )
   (setvar "nomutt" 0)
   (setq snap (getvar "osmode"))
   (setvar "osmode" 0) ;关闭
   (liangxian s1 3 )
   (while t
      (initget 4 "P E U")
      (QQQ)
      (princ zhuj2)
  (cond
      ;;分支零：右键退出
        ((= PT1 0.0)
         (exit))
      ;;分支一：投影选项设置
        ((= PT1 "P")
       (progn
       (initget 4)
       (setq
           XX (getint (strcat "\n输入投影选项 [无

(0)/UCS(1)/视图(2)] <" (itoa (getvar "PROJMODE"))  

">:"  ) )
       )
       (if (or (= XX 0) (= XX 1) (= XX 2))
             (setvar "PROJMODE" XX)
       )
       )
      )
      ;;分支二：边延伸选项设置
        ((= PT1 "E")
       (progn
       (initget 4)
       (setq XX (getint
                (strcat
                  "\n输入隐含边延伸模式 [不延伸(0)/延

伸(1)] <"
                  (itoa (getvar "EDGEMODE"))
                  ">:"
                )
            )
       )
       (if (or (= XX 0) (= XX 1))
             (setvar "EDGEMODE" XX)
       )
       )
      )
      ;;分支四：撤销上一步操作
        ((= PT1 "U")
         (command "_.undo" 1)
      )
      ;;分支五：对选中的对象进行修剪操作
      ((listp PT1)
      (progn
      (if (setq S2 (ssget PT1))
          (progn
             (command "_.undo" "be")
             (command cmd S1 "" S2 "")
             (command "_.undo" "e")
             (liangxian s1 3 )
          )
          (if (and (setq PT2 (getcorner PT1 " >>>第二

角点: " ) )
                   (setq S2 (ssget "c" PT1 PT2))
              )
             (progn
                (command "_.undo" "be")
                (command cmd S1 "")
                (setq I 0)
                (repeat (sslength S2)
                   (command  (list (ssname S2 I)

PT1))
                   (setq I (1+ I))
                )
                (command "")
                (command "_.undo" "e")
                (liangxian s1 3 )
             )
             (princ "\n★未选择到对象。")
         )
     )
     )
      ) ;_结束 分支五
  ) ;_结束 cond 结束分支
   ) ;_结束 while
   (liangxian s1 4 )
   (setvar "CMDECHO" CMDECHO_OLD)
   (setvar "osmode" snap) 打开捕捉
   (error_end)
   (princ)
) ;_结束 defun

(defun qqq ();;;选择点鼠标变成框子程序
   (princ zhuj2)
   (while (not (member (car (setq PT1 (grread T 12

2))) '(3 2 11)))
      (setq PT1 (cadr PT1))
      (if (vl-consp PT1)
        (progn
          (or PT (setq PT PT1))
          (setq X (car PT) Y (cadr PT))
          (if (> (distance PT1 PT) (P2U222 (* 0.0001

(car (getvar "screensize")))))
            (progn
              (redraw)
              (setq LEN (P2U222 1) X (car PT) Y (cadr

PT))
              (setq PT PT1)
            )
          )
        )
      )
    )
    (redraw)
    (and (= (car PT1) 3)
         (vl-consp (cadr PT1))
         (setq EN (nentselp (cadr PT1)))
    )
   (setq ent (car EN)  PT1 (cadr PT1)   )
   (cond ((or (= PT1 80) (= PT1 112))  (setq PT1

"P"))
         ((or (= PT1 69) (= PT1 101))  (setq PT1

"E"))
         ((or (= PT1 85) (= PT1 117))  (setq PT1

"U"))
   )
   (if (= PT1 0.0) (setvar "osmode" snap));打开捕捉
   (princ)
)
(defun p2u222 (pix) (* pix (/ (getvar "viewsize")

(cadr (getvar "screensize")))))
(defun liangxian (ss  n / slen I  ent );;控制选择集亮

显程序
   (if  (/= liangx 0);;亮显判断条件
        (progn
        (setq slen (sslength ss) I 0 )
        (while (ssname ss I)
           (setq ent (ssname ss I))
           (redraw ent n);亮显
           (setq I (+ 1 I))
        );end while
        );end progn
   );end if
);end defun
;;;==================================================

=========

wowan1314

自己顶顶！

langjs

我也帮你顶顶

wowan1314

楼上高手帮忙多看看，给点建议啊！是不是哪个选择点鼠标变框的子程序不支持啊？

wowan1314

改了半天，现在可以通过空格，enter来退出。就是不能右键退出。

wowan1314

晕！ 终于搞出来了！ 把选择点鼠标变框改改就好了(原来的不支持右键).关键改(grread NIL 12 2)，(while pt1 ..
再加个分支：栏选
        ((= PT1 "F")
         (PROGN (COMMAND CMD S1 "" "F")(COMAND "")))；栏选后回不到框选。

wowan1314

就差选择块内线了！！！！  选择块内单个线作为剪切边怎么实现呢？！ 块内的单线加不进选择集呀！
难道要选了块内线就把块彻底炸开，剪切完再还原？！

高手来解决下下！

xiaoyingzi

我也发个最接近06版，可框选，可点选，可栏选，可徒手选的超级剪切，源码来自狂刀，自己调整了下使之比较接近06版的剪切了

2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
3. ;| xtr = 超级剪切－－狂刀 xiaoyingzi修改于2011-08-07，
   
4.    思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url]
   
5.    可替代trim.
   
6.    参数详解:
   
7.    默认选择方式: 点到实体为点选；点于空位为框选，启动.
   
8.    U-undo: 取消上次剪切操作，一键执行无须回车!
   
9.    R-redo: 恢复一次undo操作，一键执行无须回车!
   
10.    E-edgemode: 隐含边延伸模式 [不延伸(0)/延伸(1)]
    
11.    P-projmode: 投影选项 [0 无 / 1 UCS / 2 视图]
    
12.    F-栏选
    
13.    S-徒手选: 自由画笔(sketch)方式.
    
14.    C-框选:  框选实体边方式.
    
15.      (按住Shift键延伸):同时按shift为延伸命令，而非剪切.
    
16. |;
    
17. 
    
18. (defun c:t (/ roop dis un cm os ed pr ss gr ga gb sel pt pt2 pts eg)
    
19. 
    
20.   ;;定义自己的出错函数
    
21.   (defun error (msg)      
    
22.     (if  (and
    
23.     (/= msg "console break")
    
24.     (/= msg "Function cancelled")
    
25.     (/= msg "quit/exit abort")
    
26.   )
    
27.       (progn
    
28.   (error_end)
    
29.   (princ "\n")
    
30.   (princ "*取消*")
    
31.       )
    
32.     )
    
33.   )
    
34. 
    
35.   ;;定义自己的结尾恢复函数
    
36.   (defun error_end ()
    
37.     (if ss (redrawss ss 4 ))
    
38.     (if  os (setvar "osmode" os))
    
39.     (if  ed (setvar "edgemode" ed))
    
40.     (if  pr (setvar "projmode" pr))
    
41.     (setq *error* olderr)
    
42.     (command "undo" "e")
    
43.     (if  cm (setvar "cmdecho" cm))
    
44.   )
    
45. 
    
46.   ;;显示隐藏亮显消隐函数 1.显示图元 2. 隐藏图元(使其不可见) 3.亮显图元 4.取消亮显图元
    
47.   (defun redrawss (ss mode)
    
48.      (mapcar '(lambda (x) (redraw x mode))
    
49.              (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    
50.      )
    
51.   (princ)
    
52.   )
    
53. 
    
54.   ;;取得grread跟踪点表，dis为控制精度的距离.
    
55.   (defun getpts  (dis / gr pt pt0 pts)
    
56.     (while (= 5 (car (setq gr (grread t 4 0))))
    
57.       (setq pt (cadr gr))
    
58.       (if (not pt0)
    
59.   (setq pt0 pt
    
60.         pts (cons pt0 pts)
    
61.   )
    
62.       )
    
63.       (if (> (distance pt pt0) dis)
    
64.   (progn
    
65.     (grdraw pt pt0 1 1)
    
66.     (setq  pts (cons pt pts)
    
67.     pt0 pt
    
68.     )
    
69.   )
    
70.       )
    
71.     )
    
72.     (redraw)
    
73.     (reverse pts)
    
74.   )
    
75. 
    
76.   ;;开始主程序.
    
77.   (command "undo" "be")
    
78.   (princ
    
79.      (strcat "\n当前设置:投影=" (nth (getvar "projmode") '("无" "UCS" "视图"))
    
80.               "，边=" (nth (getvar "edgemode") '("不延伸" "延伸"))
    
81.      )
    
82.   )
    
83.   (setq  olderr *error* *error* error)
    
84.   (setq  roop T
    
85.   dis  (* 0.01 (getvar "viewsize"))
    
86.   un   0
    
87.   )
    
88.   (setq  cm (getvar "cmdecho")
    
89.   os (getvar "osmode")
    
90.   ed (getvar "edgemode")
    
91.   pr (getvar "projmode")
    
92.   )
    
93.   (setvar "osmode" 0)
    
94.   (setvar "cmdecho" 0)
    
95.   (princ "\n选择对象或 <全部选择>: ")
    
96.   (setq ss (ssget))
    
97.   (if ss (redrawss ss 3 ))
    
98.   (while roop
    
99.     (princ
    
100.       "\n选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [栏选(F)/徒手选(S)/投影(P)/边(E)/重作(R)/放弃(U)]: "
     
101.     )
     
102.     (setq gr (grread nil 4 2)
     
103.     ga (car gr)
     
104.     gb (cadr gr)
     
105.     )
     
106.     (cond
     
107.       ((= ga 3)
     
108.        (cond
     
109.    ;;点选.
     
110.    ((setq sel (nentselp gb))
     
111.     (command "_.trim")
     
112.     (if ss
     
113.       (progn
     
114.               (redrawss ss 3)
     
115.         (command ss)
     
116.             )
     
117.     )
     
118.     (command "")
     
119.     (command sel "")
     
120.           (if ss (redrawss ss 3))
     
121.    )
     
122.    ;;框选.
     
123.    (T
     
124.       (if  (and (setq pt gb)
     
125.          (setq pt2 (getcorner pt "指定对角点: "))
     
126.     )
     
127.         (progn
     
128.     (setq pts (list  pt
     
129.         (list (car pt) (cadr pt2))
     
130.         pt2
     
131.         (list (car pt2) (cadr pt))
     
132.         )
     
133.     )
     
134.     (command "_.trim")
     
135.     (if ss
     
136.             (progn
     
137.                   (redrawss ss 3)
     
138.       (command ss)
     
139.                   )
     
140.     )
     
141.     (command "")
     
142.     (mapcar  '(lambda (x y) (command "f" x y ""))
     
143.       pts
     
144.       (cons (last pts) pts)
     
145.     )
     
146.     (command "")
     
147.                 (if ss (redrawss ss 3))
     
148.     (setq un (1+ un))
     
149.         )
     
150.       )
     
151.    )
     
152.        )
     
153.       )
     
154.       ;;放弃(U).
     
155.       ((member gr '((2 117) (2 85)))
     
156.        (if (> un 0)
     
157.    (progn
     
158.      (command "_.u")
     
159.      (setq un (1- un))
     
160.    )
     
161.    (princ "\n没有操作可放弃")
     
162.        )
     
163.       )
     
164.       ;;重作(R).
     
165.       ((member gr '((2 114) (2 82)))
     
166.        (setq un (1+ un))
     
167.        (command "_.redo")
     
168.       )
     
169.       ;;边(E).
     
170.       ((member gr '((2 101) (2 69)))
     
171.        (progn
     
172.        (initget 4)
     
173.        (setq
     
174.            XX (getint (strcat "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" (itoa (getvar "edgemode")) ">:" ) )
     
175.        )
     
176.        (if (or (= XX 0) (= XX 1))
     
177.              (setvar "edgemode" XX)
     
178.        )
     
179.        )
     
180.       )
     
181.       ;;投影(P)
     
182.       ((member gr '((2 112) (2 80)))
     
183.        (progn
     
184.        (initget 4)
     
185.        (setq
     
186.            XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "projmode"))  ">:"  ) )
     
187.        )
     
188.        (if (or (= XX 0) (= XX 1) (= XX 2))
     
189.              (setvar "projmode" XX)
     
190.        )
     
191.        )
     
192.       )
     
193.       ;;徒手选(S).
     
194.       ((member gr '((2 115) (2 83)))
     
195.        (setq pts (getpts dis))
     
196.        (if (setq pts2 (cdr pts))
     
197.       (progn (command "_.trim")
     
198.        (if ss            
     
199.                      (progn
     
200.                        (redrawss ss 3)
     
201.            (command ss)
     
202.                      )
     
203.        )
     
204.        (command "")
     
205.        (mapcar '(lambda (x y) (command "f" x y "")) pts pts2)
     
206.        (command "")
     
207.                    (if ss (redrawss ss 3))
     
208.       )
     
209.        )
     
210.       )
     
211.       ;;栏选(F).
     
212.       ((member gr '((2 102) (2 70)))
     
213.        (setq pt (getpoint "\n第一栏选点: "))
     
214.        (if (setq pt2 (getpoint pt "\n指定直线的端点: "))
     
215.       (progn (command "_.trim")
     
216.        (if ss            
     
217.                      (progn
     
218.                        (redrawss ss 3)
     
219.            (command ss)
     
220.                      )
     
221.        )
     
222.        (command "" "f" pt pt2 "")
     
223.        (command "")
     
224.                    (if ss (redrawss ss 3))
     
225.       )
     
226.        )
     
227.       )
     
228.       ;;空格或回车.
     
229.       ((member gr '((11 0) (2 32)))
     
230.        (setq roop nil)
     
231.       )
     
232. 
     
233.     )
     
234.   )
     
235.   (error_end)
     
236.   (princ)
     
237. )
     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> ;| xtr = 超级剪切－－狂刀 xiaoyingzi修改于2011-08-07，<br />    思路from lijiao  [url]http://www.xdcad.net/forum/showthread.php?postid=1686237#post1686237[/url] <br />    可替代trim. <br />    参数详解: <br />    默认选择方式: 点到实体为点选；点于空位为框选，启动. <br />    U-undo: 取消上次剪切操作，一键执行无须回车! <br />    R-redo: 恢复一次undo操作，一键执行无须回车! <br />    E-edgemode: 隐含边延伸模式 [不延伸(0)/延伸(1)]<br />    P-projmode: 投影选项 [0 无 / 1 UCS / 2 视图] <br />    F-栏选<br />    S-徒手选: 自由画笔(sketch)方式. <br />    C-框选:  框选实体边方式. <br />      (按住Shift键延伸):同时按shift为延伸命令，而非剪切. <br /> |;<br /> <br /> (defun c:t (/ roop dis un cm os ed pr ss gr ga gb sel pt pt2 pts eg)<br /> <br />   ;;定义自己的出错函数<br />   (defun error (msg)      <br />     (if  (and<br />     (/= msg "console break")<br />     (/= msg "Function cancelled")<br />     (/= msg "quit/exit abort")<br />   )<br />       (progn<br />   (error_end)<br />   (princ "\n")<br />   (princ "*取消*")<br />       )<br />     )<br />   )<br /> <br />   ;;定义自己的结尾恢复函数<br />   (defun error_end ()<br />     (if ss (redrawss ss 4 ))<br />     (if  os (setvar "osmode" os))<br />     (if  ed (setvar "edgemode" ed))<br />     (if  pr (setvar "projmode" pr))<br />     (setq *error* olderr)<br />     (command "undo" "e")<br />     (if  cm (setvar "cmdecho" cm))<br />   )<br /> <br />   ;;显示隐藏亮显消隐函数 1.显示图元 2. 隐藏图元(使其不可见) 3.亮显图元 4.取消亮显图元<br />   (defun redrawss (ss mode)<br />      (mapcar '(lambda (x) (redraw x mode))<br />              (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))<br />      )<br />   (princ)<br />   )<br /> <br />   ;;取得grread跟踪点表，dis为控制精度的距离. <br />   (defun getpts  (dis / gr pt pt0 pts)<br />     (while (= 5 (car (setq gr (grread t 4 0))))<br />       (setq pt (cadr gr))<br />       (if (not pt0)<br />   (setq pt0 pt<br />         pts (cons pt0 pts)<br />   )<br />       )<br />       (if (> (distance pt pt0) dis)<br />   (progn<br />     (grdraw pt pt0 1 1)<br />     (setq  pts (cons pt pts)<br />     pt0 pt<br />     )<br />   )<br />       )<br />     )<br />     (redraw)<br />     (reverse pts)<br />   )<br /> <br />   ;;开始主程序. <br />   (command "undo" "be")<br />   (princ <br />      (strcat "\n当前设置:投影=" (nth (getvar "projmode") '("无" "UCS" "视图"))<br />               "，边=" (nth (getvar "edgemode") '("不延伸" "延伸"))<br />      )<br />   )<br />   (setq  olderr *error* *error* error)<br />   (setq  roop T<br />   dis  (* 0.01 (getvar "viewsize"))<br />   un   0<br />   )<br />   (setq  cm (getvar "cmdecho")<br />   os (getvar "osmode")<br />   ed (getvar "edgemode")<br />   pr (getvar "projmode")<br />   )<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (princ "\n选择对象或 <全部选择>: ")<br />   (setq ss (ssget))<br />   (if ss (redrawss ss 3 ))<br />   (while roop<br />     (princ<br />       "\n选择要修剪的对象，或按住 Shift 键选择要延伸的对象，或 [栏选(F)/徒手选(S)/投影(P)/边(E)/重作(R)/放弃(U)]: "<br />     )<br />     (setq gr (grread nil 4 2)<br />     ga (car gr)<br />     gb (cadr gr)<br />     )<br />     (cond<br />       ((= ga 3)<br />        (cond<br />    ;;点选. <br />    ((setq sel (nentselp gb))<br />     (command "_.trim")<br />     (if ss<br />       (progn<br />               (redrawss ss 3)<br />         (command ss)<br />             )<br />     )<br />     (command "")<br />     (command sel "")<br />           (if ss (redrawss ss 3))<br />    )<br />    ;;框选. <br />    (T<br />       (if  (and (setq pt gb)<br />          (setq pt2 (getcorner pt "指定对角点: "))<br />     )<br />         (progn<br />     (setq pts (list  pt<br />         (list (car pt) (cadr pt2))<br />         pt2<br />         (list (car pt2) (cadr pt))<br />         )<br />     )<br />     (command "_.trim")<br />     (if ss<br />             (progn<br />                   (redrawss ss 3)<br />       (command ss)<br />                   )<br />     )<br />     (command "")<br />     (mapcar  '(lambda (x y) (command "f" x y ""))<br />       pts<br />       (cons (last pts) pts)<br />     )<br />     (command "")<br />                 (if ss (redrawss ss 3))<br />     (setq un (1+ un))<br />         )<br />       )<br />    )<br />        )<br />       )<br />       ;;放弃(U). <br />       ((member gr '((2 117) (2 85)))<br />        (if (> un 0)<br />    (progn<br />      (command "_.u")<br />      (setq un (1- un))<br />    )<br />    (princ "\n没有操作可放弃")<br />        )<br />       )<br />       ;;重作(R). <br />       ((member gr '((2 114) (2 82)))<br />        (setq un (1+ un))<br />        (command "_.redo")<br />       )<br />       ;;边(E). <br />       ((member gr '((2 101) (2 69))) <br />        (progn<br />        (initget 4)<br />        (setq<br />            XX (getint (strcat "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <" (itoa (getvar "edgemode")) ">:" ) )<br />        )<br />        (if (or (= XX 0) (= XX 1))<br />              (setvar "edgemode" XX)<br />        )<br />        )<br />       )<br />       ;;投影(P)<br />       ((member gr '((2 112) (2 80)))<br />        (progn<br />        (initget 4)<br />        (setq<br />            XX (getint (strcat "\n输入投影选项 [无(0)/UCS(1)/视图(2)] <" (itoa (getvar "projmode"))  ">:"  ) )<br />        )<br />        (if (or (= XX 0) (= XX 1) (= XX 2))<br />              (setvar "projmode" XX)<br />        )<br />        )<br />       )<br />       ;;徒手选(S). <br />       ((member gr '((2 115) (2 83)))<br />        (setq pts (getpts dis))<br />        (if (setq pts2 (cdr pts))<br />       (progn (command "_.trim")<br />        (if ss            <br />                      (progn<br />                        (redrawss ss 3)<br />            (command ss)<br />                      )<br />        )<br />        (command "")<br />        (mapcar '(lambda (x y) (command "f" x y "")) pts pts2)<br />        (command "")<br />                    (if ss (redrawss ss 3))<br />       )<br />        )<br />       )<br />       ;;栏选(F). <br />       ((member gr '((2 102) (2 70)))<br />        (setq pt (getpoint "\n第一栏选点: "))<br />        (if (setq pt2 (getpoint pt "\n指定直线的端点: "))<br />       (progn (command "_.trim")<br />        (if ss            <br />                      (progn<br />                        (redrawss ss 3)<br />            (command ss)<br />                      )<br />        )<br />        (command "" "f" pt pt2 "")<br />        (command "")<br />                    (if ss (redrawss ss 3))<br />       )<br />        )<br />       )<br />       ;;空格或回车.<br />       ((member gr '((11 0) (2 32)))<br />        (setq roop nil)<br />       )<br /> <br />     )<br />   )<br />   (error_end)<br />   (princ)<br /> )<br />

wowan1314

楼上的栏选只能两点！  右键不能退出（估计按我改得那样改改也能实现）！
块跟线一起选不能剪切！ 块内单个线也不能选呢！

不过还是感谢你的参与! 看来喜欢CAD2004的还是有些人的！ 呵呵

429014673

xiaoyingzi 发表于 2012-3-29 20:37
我也发个最接近06版，可框选，可点选，可栏选，可徒手选的超级剪切，源码来自狂刀，自己调整了下使之比较接 ...

右键不能退出