请帮忙看看这个trim的lisp问题出在哪里：

mandala

画一条pline，剪切掉被pline围住的多段线、直线、圆弧或者曲线，如图：

2. (defun c:trm (/ e1 elist trn en p1 p2 ss p3 n )
   
3.   
   
4.   (setvar "osmode" 0)
   
5. (command "_.pline")
   
6. (while (= 1 (getvar "cmdactive"))(command pause))
   
7.   (setq e1 (entlast))
   
8.   (setq elist (entget e1))
   
9.   (setq trn (cdr (assoc -1 elist)))
   
10.   (setq en (vlax-ename->vla-object trn))
    
11.   (vla-getboundingbox en 'p1 'p2)
    
12.   (setq p1 (vlax-safearray->list p1)
    
13.            p2 (vlax-safearray->list p2)
    
14.   )
    
15.   (setq ss (ssget "c" p1 p2))
    
16.   (setq p3 (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (vlax-curve-getEndPoint e1) (vlax-curve-getstartPoint e1)));;p3为pline头尾连线的中点
    
17.   (setq n -1)
    
18.       (repeat (sslength ss)
    
19.               (setq en (ssname ss (setq n (1+ n))))
    
20.           (if (not (eq en trn))
    
21.                (command "trim" e1 "" (list en p3) "")
    
22.           )
    
23.       )
    
24. (entdel e1)
    
25. )

(defun c:trm (/ e1 elist trn en p1 p2 ss p3 n )<br />   <br />   (setvar "osmode" 0)<br /> (command "_.pline")<br /> (while (= 1 (getvar "cmdactive"))(command pause))<br />   (setq e1 (entlast))<br />   (setq elist (entget e1))<br />   (setq trn (cdr (assoc -1 elist)))<br />   (setq en (vlax-ename->vla-object trn))<br />   (vla-getboundingbox en 'p1 'p2)<br />   (setq p1 (vlax-safearray->list p1)<br />            p2 (vlax-safearray->list p2)<br />   )<br />   (setq ss (ssget "c" p1 p2))<br />   (setq p3 (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (vlax-curve-getEndPoint e1) (vlax-curve-getstartPoint e1)));;p3为pline头尾连线的中点<br />   (setq n -1)<br />       (repeat (sslength ss)<br />               (setq en (ssname ss (setq n (1+ n))))<br />           (if (not (eq en trn))<br />                (command "trim" e1 "" (list en p3) "")<br />           )<br />       )<br /> (entdel e1)<br /> )

问题是这个lisp有时候灵有时候不灵，汗一个。应该是通过ssget来获取与pline相交的图元时，方式不对，因为如果pline画得比较斜的话，trim就剪切得不对。请帮我看看问题出在哪里呢？另外有没有更好的方法来实现呢？

wuqitao0000

我一个圆弧画管的程序也类似，把人逼疯了。上传帮看看，也是剪切不可预测。
在2006以前的版本上还行，2008就疯了。

xiaxiang

回复 mandala 的帖子

猜测：(setvar "edgemode" 1).不对勿怪。

mandala

谢谢，不过不是这个原因。

qjchen

:)
测试了一下程序，程序挺有意思的。主要是不清楚楼主程序的目的。假如是用一个PL来切其他图形（一个或者多个的话），为什么用boundingbox，其实取出多段线的3个点，用f的选择模式而不是c模式会更好。 (list en p3) 中的p3，也可以考虑用PL和物体相交得到的交点Parameter来反算。

mandala

回复 qjchen 的帖子

也曾经想过你说的这个办法，但是水平有限，总是写不好。主要问题是f的选择模式，f线该怎么画呢，就是pline本身的这条线吗，还是要在pl里边作一条平行线？下边这段是pl本身，结果很糟；也写过作条平行线来 f ，结果也不理想。

2. (defun c:tt(/ e1  obj plist pp n p1)
   
3. (setvar "osmode" 0)
   
4. (command "_.pline")
   
5. (while (= 1 (getvar "cmdactive"))(command pause))
   
6.   (setq e1 (entlast))
   
7. (setq obj (vlax-ename->vla-object e1))
   
8.   (setq plist (vlax-safearray->list
   
9.   (vlax-variant-value
   
10.     (vla-get-coordinates obj))))
    
11.     (setq n 0)
    
12.   (repeat (/ (length plist) 2)
    
13.     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
    
14.     (setq n (+ n 2))
    
15.   )
    
16. (setq n 0)
    
17. (command "trim" e1 "" "f")
    
18. (repeat (/ (length plist) 2)
    
19. (setq p1 (nth n pp))
    
20. (command  p1)
    
21. (setq n (1+ n))
    
22. )
    
23. (command """")
    
24. (entdel e1)
    
25. 
    
26. )

(defun c:tt(/ e1  obj plist pp n p1)<br /> (setvar "osmode" 0)<br /> (command "_.pline")<br /> (while (= 1 (getvar "cmdactive"))(command pause))<br />   (setq e1 (entlast))<br /> (setq obj (vlax-ename->vla-object e1))<br />   (setq plist (vlax-safearray->list<br />   (vlax-variant-value<br />     (vla-get-coordinates obj))))<br />     (setq n 0)<br />   (repeat (/ (length plist) 2)<br />     (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))<br />     (setq n (+ n 2))<br />   )<br /> (setq n 0)<br /> (command "trim" e1 "" "f")<br /> (repeat (/ (length plist) 2)<br /> (setq p1 (nth n pp))<br /> (command  p1)<br /> (setq n (1+ n))<br /> )<br /> (command """")<br /> (entdel e1)<br /> <br /> )

qjchen

(command "trim" e1 "" "f") 这句话不应该这样写，应该是先构建f选择集，再处理的，手头没有ACAD，无法调试，给一些其他的建议吧.:)

个人说的F是选择模式的意思，就是你在CAD中，键入命令 select之后，你按个C看看，按个F看看

另，这个问题不知道楼主是否想这样

画一个PL（个人建议是封闭的，否则不知道内外之分），然后修剪其内所有的物体

那么这个程序要仔细编好的话，是需要挺多时间的，

可以试试 http://bbs.mjtd.com/forum.php?mo ... hlight=%C7%F8%D3%F2 中提到的express tools里的extrim命令.
这个晓东的snsj版主是编过一个 http://www.xdcad.net/forum/showthread.php?postid=1032386

假如想全部自己编，比较好的做法最好是不用trim，因为这个命令要构建出物体和选择点会比较麻烦些

可以用break，将被此PLINE的顶点构成的点集用F模式(ssget 的F模式，更好应该用CP模式)选中的物体，在交点打断（此时，必须用intersectwith函数来得到交点），再删除位于PLINE点集内的物体


网上也有一些相关的代码

王咣生 版主提过的
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=25339&highlight=%C7%F8%D3%F2

如.net 版飞狐版主的 http://bbs.mjtd.com/forum.php?mo ... hlight=%D0%DE%BC%F4

根据多边形顶点进行选择的，可参考一下

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26393&highlight=%C7%F8%D3%F2

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=26393&highlight=%C7%F8%D3%F2

http://www.xdcad.net/forum/showt ... splay=&pagenumber=1

也可以在 mjtd中查找 区域 或者 修剪，你会发现许多好文章的

比如Highflybird兄的 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=56244&highlight=%C7%F8%D3%F2

hmseu

回复 qjchen 的帖子

回复很有深度，感觉像科研论文

mandala

回复 qjchen 的帖子

谢谢，我研究一下。

mandala

没研究出来什么结果。查了一下，这似乎是个老大难问题了，研究的人很多，但没什么完美的lsp。另外cad的“F”选择模式还是有问题的，对虚线不灵，如果“F”划中虚线的空白部分时就选不中。即使是express里边的extrim.lsp也一样。而我要这个lsp主要就是针对虚线的，晕。

现在我火大了就直接把extrim拿过来，改成先画线后剪切，方向点直接定为中点，为提高速度再删掉那些zoom的语句，把regenmode设为0，最后把ltscale设成一万……这样总划不中虚线的空挡了吧！！！

现在正厚颜无耻地将就用着，速度是稍微慢了点，也还能忍受。各位老大，能再帮帮忙想想办法吗？最好是能把1楼的程序优化一番？

ZZXXQQ

给个用BREAK的。

1. ;用BREAK打断线条 明经 ZZXXQQ 2011.1.10
   
2. (defun c:trm (/ e1 elist trn en p1 p2 ss p3 n )
   
3. (setvar "CMDECHO" 0)
   
4. (setvar "OSMODE" 0)
   
5. (command "_.UNDO" "BE")
   
6. (if (and (setq s1 (entsel "\n选择线条 :"))
   
7.           (setq b (getdist "\n打断宽度 :"))) (progn
   
8.   (setq ent (entget(car s1)))
   
9.   (if (assoc 6 ent)
   
10.    (setq ltn (cdr(assoc 6 ent))
    
11.    ent1 (subst '(6 . "CONTINUOUS") (assoc 6 ent) ent))
    
12.    (setq ln (cdr(assoc 8 ent))
    
13.    ent1 (subst '(8 . "0") (assoc 8 ent) ent))
    
14.   )
    
15.   (entmod ent1)
    
16.   (setq pt1 (osnap (cadr s1) "NEA")
    
17.         ang (+ (/ pi 2) (angle pt1 (cadr s1)))
    
18.         pt2 (polar pt1 ang (/ b 2))
    
19.         pt1 (polar pt2 (+ ang pi) b))
    
20.   (command "_.BREAK" s1 "F" pt1 pt2)
    
21.   (if (assoc 6 ent)
    
22.    (command "_.CHPROP" s1 "L" "" "LT" ltn "")
    
23.    (command "_.CHPROP" s1 "L" "" "LA" ln "")
    
24.   )
    
25. ))
    
26. (setvar "CMDECHO" 1)
    
27. (princ)
    
28. )
    

;用BREAK打断线条 明经 ZZXXQQ 2011.1.10<br /> (defun c:trm (/ e1 elist trn en p1 p2 ss p3 n )<br /> (setvar "CMDECHO" 0)<br /> (setvar "OSMODE" 0)<br /> (command "_.UNDO" "BE")<br /> (if (and (setq s1 (entsel "\n选择线条 :"))<br />           (setq b (getdist "\n打断宽度 :"))) (progn<br />   (setq ent (entget(car s1)))<br />   (if (assoc 6 ent)<br />    (setq ltn (cdr(assoc 6 ent))<br />    ent1 (subst '(6 . "CONTINUOUS") (assoc 6 ent) ent))<br />    (setq ln (cdr(assoc 8 ent))<br />    ent1 (subst '(8 . "0") (assoc 8 ent) ent))<br />   )<br />   (entmod ent1)<br />   (setq pt1 (osnap (cadr s1) "NEA")<br />         ang (+ (/ pi 2) (angle pt1 (cadr s1)))<br />         pt2 (polar pt1 ang (/ b 2))<br />         pt1 (polar pt2 (+ ang pi) b))<br />   (command "_.BREAK" s1 "F" pt1 pt2)<br />   (if (assoc 6 ent)<br />    (command "_.CHPROP" s1 "L" "" "LT" ltn "")<br />    (command "_.CHPROP" s1 "L" "" "LA" ln "")<br />   )<br /> ))<br /> (setvar "CMDECHO" 1)<br /> (princ)<br /> )<br />