打断PLINE,

前生

见贴图，希望一个小的LSP程序，选择一个PLINE后，如果有直线段，则最长的直线段打断，变成一个开口的PLINE.谢谢!

tryhi

2. ;;打断最长的直线边
   
3. ;;BY-tryhi大海
   
4. (defun c:tt (/ ens)
   
5.         (command  "UNDO" "be")
   
6.         (setq ens (try-ss2EnList(ssget '((0 . "LWPOLYLINE")(-4 . "&")(70 . 1)))))
   
7.         (foreach n ens (brtt n))
   
8.         (command "UNDO" "end")
   
9. )
   
10. (defun brtt (en / en enl enlst enlst-l llst ss ss1)
    
11.         (setq enl(entlast))
    
12.         (command "_explode" en)
    
13.         (setq ss0(try-ssend enl))
    
14.         (command "SELECT" ss "")
    
15.         (setq ss(ssget "P" '((0 . "line")))
    
16.                 enlst(try-ss2EnList ss)
    
17.                 Llst(mapcar '(lambda(e)(vla-get-Length(vlax-ename->vla-object e))) enlst)
    
18.                 enlst-l(mapcar 'list enlst Llst)
    
19.                 enlst-l (vl-sort enlst-l '(lambda(a b)(> (cadr a)(cadr b))))
    
20.                 en1(car (car enlst-l))
    
21.                 ss1(ssdel en1 ss0)
    
22.         )
    
23.         (command "_pedit" "m" ss1 "" "" "j" "" "")
    
24.         (command "ERASE"(car (car enlst-l))"")
    
25. )
    
26. (defun try-ssend(en / ss)
    
27.         (setq ss (ssadd))
    
28.         (while (setq en(entnext en))
    
29.                 (setq ss(ssadd en ss))
    
30.         )
    
31.         ss
    
32. )
    
33. (defun try-Enlist2ss(enlist / ss)
    
34.         (setq ss (ssadd))
    
35.         (foreach n (reverse enlist) (ssadd n ss))
    
36. )
    
37. (defun try-ss2EnList(ss / a en lst)
    
38.         (setq a -1)
    
39.         (if ss
    
40.                 (while
    
41.                         (setq en(ssname ss(setq a(1+ a))))
    
42.                         (setq lst(cons en lst))
    
43.                 )
    
44.         )
    
45.         (reverse lst)
    
46. )

;;打断最长的直线边<br /> ;;BY-tryhi大海<br /> (defun c:tt (/ ens)<br />         (command  "UNDO" "be")<br />         (setq ens (try-ss2EnList(ssget '((0 . "LWPOLYLINE")(-4 . "&")(70 . 1)))))<br />         (foreach n ens (brtt n))<br />         (command "UNDO" "end")<br /> )<br /> (defun brtt (en / en enl enlst enlst-l llst ss ss1)<br />         (setq enl(entlast))<br />         (command "_explode" en)<br />         (setq ss0(try-ssend enl))<br />         (command "SELECT" ss "")<br />         (setq ss(ssget "P" '((0 . "line")))<br />                 enlst(try-ss2EnList ss)<br />                 Llst(mapcar '(lambda(e)(vla-get-Length(vlax-ename->vla-object e))) enlst)<br />                 enlst-l(mapcar 'list enlst Llst)<br />                 enlst-l (vl-sort enlst-l '(lambda(a b)(> (cadr a)(cadr b))))<br />                 en1(car (car enlst-l))<br />                 ss1(ssdel en1 ss0)<br />         )<br />         (command "_pedit" "m" ss1 "" "" "j" "" "")<br />         (command "ERASE"(car (car enlst-l))"")<br /> )<br /> (defun try-ssend(en / ss)<br />         (setq ss (ssadd))<br />         (while (setq en(entnext en))<br />                 (setq ss(ssadd en ss))<br />         )<br />         ss<br /> )<br /> (defun try-Enlist2ss(enlist / ss)<br />         (setq ss (ssadd))<br />         (foreach n (reverse enlist) (ssadd n ss))<br /> )<br /> (defun try-ss2EnList(ss / a en lst)<br />         (setq a -1)<br />         (if ss<br />                 (while<br />                         (setq en(ssname ss(setq a(1+ a))))<br />                         (setq lst(cons en lst))<br />                 )<br />         )<br />         (reverse lst)<br /> )

xujinhua

tryhi 发表于 2016-4-4 23:25

厉害。。。

前生

可以。
1:原意是想有个不用Command命令的lsp,通过对pline线的计算，来生成。
2:最长的直线，希望是切掉一段，二头各留一小段直边。

自贡黄明儒

前生 发表于 2016-4-7 23:20
可以。
1:原意是想有个不用Command命令的lsp,通过对pline线的计算，来生成。
2:最长的直线，希望是切掉一 ...

这个愿望应该是可以，你也是老革命了，想必可以办到。

流动的清泉

真高手，

xiaolong1487

学下方法，，，

xiaolong1487

这里不知道有没有问题，好像也不影响程序执行！

前生

没采用上面的方法，用了以前陈伯雄老师讲的一种选择+点的方法。