[原创]：界线一侧快捷剪切

gysjy

http://www.xdcad.net/forum/showt ... y=&pagenumber=2

最初由 真龙天子 发布
[B]能否请gysjy再进一步开发一下,使之能沿splline或者pline线(不一定封闭)所形成的边界剪裁,鼠标点线的左边即剪掉与线相交实体的左边部分,鼠标点线的右边即剪掉与线相交实体的右边部分.这样就可以适应各种剪裁需要了,不知能否达到? [/B]

命令名：qtrim
使用时，将拾取框指向直线或多义线，则偏向拾取框一侧的图元被自动剪除。得到一种特殊效果。

2. 
   
3.   [FONT=courier new]
   
4. (defun to(n)
   
5.   (cdr (assoc n (entget sn)))
   
6. )
   
7. (defun MODES (a)
   
8.   (setq MLST '())
   
9.   (repeat (length a)
   
10.     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
    
11.     (setq a (cdr a))
    
12.   )
    
13. )
    
14. 
    
15. (defun MODER ()
    
16.   (repeat (length MLST)
    
17.     (setvar (caar MLST) (cadar MLST))
    
18.     (setq MLST (cdr MLST))
    
19.   )
    
20. )
    
21. 
    
22. (princ "\n界线剪切，命令名: qtrim。GYSJY, 2007.8.21")
    
23. (defun c:qtrim(/ sn p0 p1 p2 s1 s2 lst)
    
24.   (command "undo" "g")  
    
25.   (modes '("cmdecho" "osmode" "pickbox" "APERTURE" ))
    
26.   (setvar "cmdecho" 0)
    
27.   (setvar "osmode" 0)
    
28.   (setvar "pickbox" 5)
    
29.   (setvar "APERTURE" 5)   
    
30.   (graphscr)
    
31.   (while (setq sn (entsel "\n选择界线:"))
    
32.     (setq p0 (cadr sn) sn (car sn))
    
33.     (if (or (= (to 0) "LINE")(= (to 0) "LWPOLYLINE"))
    
34.       (progn
    
35.         (command "offset" "0.1" sn p0 "")
    
36.         (setq s1 sn sn (entlast))
    
37.         (cond
    
38.           ((= "LINE" (to 0))
    
39.             (setq p1 (to 10) p2 (to 11) lst (list p1 p2))
    
40.             (command "trim" s1 "" "f" p1 p2 "" "")
    
41.             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
    
42.             (command "erase" sn "")
    
43.           )
    
44.           ((= "LWPOLYLINE" (to 0))
    
45.             (plpoint)
    
46.             (repeat 5
    
47.               (command "trim" s1 "" "f" (foreach n lst (command n) "" ) "")
    
48.             )
    
49.             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
    
50.           )
    
51.           (t
    
52.              
    
53.           )
    
54.         )
    
55.       )
    
56.       (princ "\n>>>界线类型应为：LINE / LWPOLYLINE")
    
57.     )
    
58.   )
    
59.   (moder)
    
60.   (command "undo" "e")
    
61.   (princ)
    
62. )
    
63. (defun plpoint(/ en n ei );;求得PLINE线的各个顶点；
    
64.     (setq en (entget sn)
    
65.             n 0 lst '()
    
66.     )
    
67.     (while (/= (setq ei (nth n en)) nil)
    
68.             (if        (= (car ei) 10)
    
69.                 (setq lst (cons (cdr ei) lst))
    
70.             )
    
71.             (setq n (1+ n))
    
72.     )
    
73.     (setq lst (reverse lst)); lst (cons (last lst) lst))
    
74.     (if (= (to 70) 1)(setq lst (cons (last lst) lst)))
    
75.     (princ)
    
76. )
    
77. 
    
78.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun to(n)<br />   (cdr (assoc n (entget sn)))<br /> )<br /> (defun MODES (a)<br />   (setq MLST '())<br />   (repeat (length a)<br />     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))<br />     (setq a (cdr a))<br />   )<br /> )<br /> <br /> (defun MODER ()<br />   (repeat (length MLST)<br />     (setvar (caar MLST) (cadar MLST))<br />     (setq MLST (cdr MLST))<br />   )<br /> )<br /> <br /> (princ "\n界线剪切，命令名: qtrim。GYSJY, 2007.8.21") <br /> (defun c:qtrim(/ sn p0 p1 p2 s1 s2 lst)<br />   (command "undo" "g")  <br />   (modes '("cmdecho" "osmode" "pickbox" "APERTURE" )) <br />   (setvar "cmdecho" 0) <br />   (setvar "osmode" 0) <br />   (setvar "pickbox" 5)<br />   (setvar "APERTURE" 5)    <br />   (graphscr)<br />   (while (setq sn (entsel "\n选择界线:"))<br />     (setq p0 (cadr sn) sn (car sn))<br />     (if (or (= (to 0) "LINE")(= (to 0) "LWPOLYLINE"))<br />       (progn<br />         (command "offset" "0.1" sn p0 "") <br />         (setq s1 sn sn (entlast))<br />         (cond<br />           ((= "LINE" (to 0))<br />             (setq p1 (to 10) p2 (to 11) lst (list p1 p2))<br />             (command "trim" s1 "" "f" p1 p2 "" "")<br />             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))<br />             (command "erase" sn "")<br />           )<br />           ((= "LWPOLYLINE" (to 0))<br />             (plpoint)<br />             (repeat 5 <br />               (command "trim" s1 "" "f" (foreach n lst (command n) "" ) "")<br />             )<br />             (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))<br />           )<br />           (t<br />              <br />           )<br />         )<br />       )<br />       (princ "\n>>>界线类型应为：LINE / LWPOLYLINE")<br />     )<br />   )<br />   (moder) <br />   (command "undo" "e")<br />   (princ)<br /> )<br /> (defun plpoint(/ en n ei );;求得PLINE线的各个顶点；<br />     (setq en (entget sn)<br />             n 0 lst '() <br />     )<br />     (while (/= (setq ei (nth n en)) nil)<br />             (if        (= (car ei) 10)<br />                 (setq lst (cons (cdr ei) lst))<br />             )<br />             (setq n (1+ n))<br />     )<br />     (setq lst (reverse lst)); lst (cons (last lst) lst))<br />     (if (= (to 70) 1)(setq lst (cons (last lst) lst)))<br />     (princ)<br /> )<br /> <br />   [/FONT]<br />