请教关于trim命令的修改

柱哥

请问如何修以下代码，让框选修剪后保留框选内的曲线！


下图是想要得到的效果：

2. (defun c:tf (/)
   
3.   (command "undo" "be")
   
4.   (prompt "\n 选择修剪的图形:")
   
5.   (setq  ss (ssget '((-4 . "<NOT")
   
6.         (0 . "LINE")
   
7.         (-4 . "NOT>")
   
8.        )
   
9.      )
   
10.   )
    
11.   (setq  svd_os  (getvar "osmode")
    
12.   svd_cmd  (getvar "cmdecho")
    
13.   )
    
14.   (setvar "cmdecho" 0)
    
15.   (setvar "osmode" 0)
    
16.   (setq  xq (last (ssnamex ss 0))
    
17.   p1 (last (cadr xq))
    
18.   p3 (last (cadddr xq))
    
19.   )
    
20.   (setq s1 (ssget "w" p1 p3 '((0 . "CIRCLE"))))
    
21.   (if s1
    
22.     (progn
    
23.       (setq s1i 0)
    
24.       (repeat (sslength s1)
    
25.   (setq sn (ssname s1 s1i))
    
26.   (setq pl (circ_pts sn))
    
27.   (command "trim" sn "" "f")
    
28.   (foreach x pl (command x))
    
29.   (command "" "")
    
30.   (setq s1i (1+ s1i))
    
31.       )
    
32.     )
    
33.   )
    
34.   (setq s2 (ssget "w" p1 p3 '((0 . "LWPOLYLINE"))))
    
35.   (if s2
    
36.     (progn
    
37.       (setq s2i 0)
    
38.       (repeat (sslength s2)
    
39.   (setq sn (ssname s2 s2i))
    
40.   (setq pl (massoc 10 (entget sn)))
    
41.   (setq pm (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car pl) (caddr pl)))    ;中点
    
42.   (command "offset" "0.001" sn pm "")
    
43.   (setq enl (entlast))
    
44.   (setq pl (massoc 10 (entget enl))
    
45.         pl (append pl (list (car pl)))
    
46.   )
    
47.   (entdel enl)
    
48.   (command ".trim" sn "" "f")
    
49.   (foreach x pl (command x))
    
50.   (command "" "")
    
51.   (setq s2i (1+ s2i))
    
52.       )
    
53.     )
    
54.   )
    
55.   (setvar "cmdecho" svd_cmd)
    
56.   (setvar "osmode" svd_os)
    
57.   (command "undo" "e")
    
58.   (princ)
    
59. )
    
60. 
    
61. (defun circ_pts  (enm) ;选区为圆点表
    
62.   (setq  lst (entget enm)
    
63.   ang (* pi 2)
    
64.   inc (/ ang 64)
    
65.   tmp '()
    
66.   seg 65
    
67.   )
    
68.   (repeat seg
    
69.     (setq pt  (polar (cdr (assoc 10 lst)) ang (- (cdr (assoc 40 lst)) 0.01))
    
70.     ang (+ inc ang)
    
71.     )
    
72.     (setq tmp (cons pt tmp))
    
73.   )
    
74.   tmp
    
75. )
    
76. 
    
77. ;(massoc 10 (entget (car (entsel))))
    
78. (defun massoc (key alist / x nlist)    ;选区为多段线各顶点表
    
79.   (foreach x alist
    
80.     (if  (eq key (car x))
    
81.       (setq nlist (cons (cdr x) nlist))
    
82.     )
    
83.   )
    
84.   (reverse nlist)
    
85. )

(defun c:tf (/)<br />   (command "undo" "be")<br />   (prompt "\n 选择修剪的图形:")<br />   (setq  ss (ssget '((-4 . "<NOT")<br />         (0 . "LINE")<br />         (-4 . "NOT>")<br />        )<br />      )<br />   )<br />   (setq  svd_os  (getvar "osmode")<br />   svd_cmd  (getvar "cmdecho")<br />   )<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)<br />   (setq  xq (last (ssnamex ss 0))<br />   p1 (last (cadr xq))<br />   p3 (last (cadddr xq))<br />   )<br />   (setq s1 (ssget "w" p1 p3 '((0 . "CIRCLE"))))<br />   (if s1<br />     (progn<br />       (setq s1i 0)<br />       (repeat (sslength s1)<br />   (setq sn (ssname s1 s1i))<br />   (setq pl (circ_pts sn))<br />   (command "trim" sn "" "f")<br />   (foreach x pl (command x))<br />   (command "" "")<br />   (setq s1i (1+ s1i))<br />       )<br />     )<br />   )<br />   (setq s2 (ssget "w" p1 p3 '((0 . "LWPOLYLINE"))))<br />   (if s2<br />     (progn<br />       (setq s2i 0)<br />       (repeat (sslength s2)<br />   (setq sn (ssname s2 s2i))<br />   (setq pl (massoc 10 (entget sn)))<br />   (setq pm (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car pl) (caddr pl)))    ;中点<br />   (command "offset" "0.001" sn pm "")<br />   (setq enl (entlast))<br />   (setq pl (massoc 10 (entget enl))<br />         pl (append pl (list (car pl)))<br />   )<br />   (entdel enl)<br />   (command ".trim" sn "" "f")<br />   (foreach x pl (command x))<br />   (command "" "")<br />   (setq s2i (1+ s2i))<br />       )<br />     )<br />   )<br />   (setvar "cmdecho" svd_cmd)<br />   (setvar "osmode" svd_os)<br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br /> (defun circ_pts  (enm) ;选区为圆点表<br />   (setq  lst (entget enm)<br />   ang (* pi 2)<br />   inc (/ ang 64)<br />   tmp '()<br />   seg 65<br />   )<br />   (repeat seg<br />     (setq pt  (polar (cdr (assoc 10 lst)) ang (- (cdr (assoc 40 lst)) 0.01))<br />     ang (+ inc ang)<br />     )<br />     (setq tmp (cons pt tmp))<br />   )<br />   tmp<br /> )<br /> <br /> ;(massoc 10 (entget (car (entsel))))<br /> (defun massoc (key alist / x nlist)    ;选区为多段线各顶点表<br />   (foreach x alist<br />     (if  (eq key (car x))<br />       (setq nlist (cons (cdr x) nlist))<br />     )<br />   )<br />   (reverse nlist)<br /> )

USER2128

将(command "offset" "0.001" sn pm "")换成:
(vla-offset (vlax-ename->vla-object sn) 0.001)

将(setq pt  (polar (cdr (assoc 10 lst)) ang (- (cdr (assoc 40 lst)) 0.01))换成:
(setq pt  (polar (cdr (assoc 10 lst)) ang (+ (cdr (assoc 40 lst)) 0.01))
试试