【悬赏5明经币求程序】求"交点打断"的lisp

chenjian2159

求：如果有一大片的线，纵横交错，不在乎是哪个图层，能不能实现这样一个程序，每个交点的两根线（线是直线、弧线、PLINE线等）的在交点处打断。步骤：先框选一大片线，然后空格后，就打断有交点的线。

xiaxiang

这个程序可实现线，圆弧，多义线，圆，样条曲线等等的打断。
演示中只有线，其它的可自己试。

七七0707

1. ;;选择集求交点子程序
   
2. (defun interss (ss / n1 ssl aobj1 aobj2 n2 ipts pts)
   
3.   (setq    n1  0
   
4.     ssl (sslength ss)
   
5.   )
   
6.   (while (< n1 (1- ssl))
   
7.     (setq aobj1    (ssname ss n1)
   
8.       aobj1    (vlax-ename->vla-object aobj1)
   
9.       n2    (1+ n1)
   
10.     )
    
11.     (while (< n2 ssl)
    
12.       (setq aobj2 (ssname ss n2)
    
13.         aobj2 (vlax-ename->vla-object aobj2)
    
14.         ipts  (vla-intersectwith
    
15.             aobj1
    
16.             aobj2
    
17.             0
    
18.           )
    
19.         ipts  (vlax-variant-value ipts)
    
20.       )
    
21.       (if (> (vlax-safearray-get-u-bound ipts 1) 0) ;是否有交点
    
22.     (progn
    
23.       (setq    ipts
    
24.          (vlax-safearray->list ipts)
    
25.       )
    
26.       (while (> (length ipts) 0)
    
27.         (setq pts (cons (list (car ipts)
    
28.                   (cadr ipts)
    
29.                   (caddr ipts)
    
30.                 )
    
31.                 pts
    
32.               ) ;此处可以在添加时判断是否有重合点
    
33.         )
    
34.         (setq ipts (cdddr ipts))
    
35.       )
    
36.     )
    
37.       )
    
38.       (setq n2 (1+ n2))
    
39.     )
    
40.     (setq n1 (1+ n1))
    
41.   )
    
42.   pts
    
43. )
    
44. 
    
45. (defun Break_ss (ss filter / pts pick thisdrawing oldos)
    
46. 
    
47.   (if ss     
    
48.     (progn
    
49.       (setq pts        (interss ss)
    
50.         pick    (getvar "pickbox")
    
51.         thisdrawing    (vla-get-activedocument
    
52.               (vlax-get-acad-object)
    
53.             )
    
54.       )
    
55.       (if pts
    
56.         (progn
    
57.       (vla-startundomark thisdrawing)
    
58.       (foreach x pts
    
59.     (if (ssget
    
60.           "_C"
    
61.           (polar x (* -0.75 pi) (* 2. (expt (/ pick 2) 2)))
    
62.           (polar x (* 0.45 pi) (* 2. (expt (/ pick 2) 2)))
    
63.           filter
    
64.         )
    
65.       (vlax-for i (vla-get-activeselectionset thisdrawing)
    
66.         (if
    
67.           (not (or (equal (vlax-curve-getstartpoint i)
    
68.                   x
    
69.                   0.001
    
70.                )
    
71.                (equal (vlax-curve-getendpoint i)
    
72.                   x
    
73.                   0.001
    
74.                )
    
75.            )
    
76.           )
    
77.            (vl-cmdf    ".break"
    
78.             (list (vlax-vla-object->ename i) x)
    
79.             "f"
    
80.             x
    
81.             "@"
    
82.            )
    
83.         )
    
84.       )
    
85.     )
    
86.       )
    
87.      
    
88.    
    
89.     (vla-endundomark thisdrawing)
    
90.       );progn
    
91.         )
    
92.       );progn
    
93.   ) ;if
    
94.   
    
95.   (princ)
    
96. )
    
97. ;;;测试
    
98. (defun c:tt()
    
99.    (setq ss (ssget '((0 . "*line,arc,circle,ELLIPSE"))))
    
100.    (if ss
     
101.      (Break_ss ss '((0 . "*line,arc,circle,ELLIPSE")))
     
102.      )
     
103.    (princ)
     
104.    )
     

;;选择集求交点子程序 <br /> (defun interss (ss / n1 ssl aobj1 aobj2 n2 ipts pts) <br />   (setq    n1  0 <br />     ssl (sslength ss) <br />   ) <br />   (while (< n1 (1- ssl)) <br />     (setq aobj1    (ssname ss n1) <br />       aobj1    (vlax-ename->vla-object aobj1) <br />       n2    (1+ n1) <br />     ) <br />     (while (< n2 ssl) <br />       (setq aobj2 (ssname ss n2) <br />         aobj2 (vlax-ename->vla-object aobj2) <br />         ipts  (vla-intersectwith <br />             aobj1 <br />             aobj2 <br />             0 <br />           ) <br />         ipts  (vlax-variant-value ipts) <br />       ) <br />       (if (> (vlax-safearray-get-u-bound ipts 1) 0) ;是否有交点<br />     (progn <br />       (setq    ipts <br />          (vlax-safearray->list ipts) <br />       ) <br />       (while (> (length ipts) 0) <br />         (setq pts (cons (list (car ipts) <br />                   (cadr ipts) <br />                   (caddr ipts) <br />                 ) <br />                 pts <br />               ) ;此处可以在添加时判断是否有重合点<br />         ) <br />         (setq ipts (cdddr ipts)) <br />       ) <br />     ) <br />       ) <br />       (setq n2 (1+ n2)) <br />     ) <br />     (setq n1 (1+ n1)) <br />   )<br />   pts<br /> )<br /> <br /> (defun Break_ss (ss filter / pts pick thisdrawing oldos) <br /> <br />   (if ss     <br />     (progn <br />       (setq pts        (interss ss) <br />         pick    (getvar "pickbox") <br />         thisdrawing    (vla-get-activedocument <br />               (vlax-get-acad-object) <br />             ) <br />       )<br />       (if pts<br />         (progn<br />       (vla-startundomark thisdrawing) <br />       (foreach x pts <br />     (if (ssget <br />           "_C" <br />           (polar x (* -0.75 pi) (* 2. (expt (/ pick 2) 2))) <br />           (polar x (* 0.45 pi) (* 2. (expt (/ pick 2) 2))) <br />           filter <br />         ) <br />       (vlax-for i (vla-get-activeselectionset thisdrawing) <br />         (if <br />           (not (or (equal (vlax-curve-getstartpoint i) <br />                   x <br />                   0.001 <br />                ) <br />                (equal (vlax-curve-getendpoint i) <br />                   x <br />                   0.001 <br />                ) <br />            ) <br />           ) <br />            (vl-cmdf    ".break" <br />             (list (vlax-vla-object->ename i) x) <br />             "f" <br />             x <br />             "@" <br />            ) <br />         ) <br />       ) <br />     ) <br />       ) <br />      <br />     <br />     (vla-endundomark thisdrawing)<br />       );progn<br />         )<br />       );progn<br />   ) ;if<br />   <br />   (princ) <br /> )<br /> ;;;测试<br /> (defun c:tt()<br />    (setq ss (ssget '((0 . "*line,arc,circle,ELLIPSE"))))<br />    (if ss<br />      (Break_ss ss '((0 . "*line,arc,circle,ELLIPSE")))<br />      )<br />    (princ)<br />    )<br />

xiaxiang

请楼主给出一个足够复杂的样图。还有，对断开距离有没有要求？

chenjian2159

两个都不错，请版主帮我平均分配下明经币！！！

yoyoho

感谢分享程序及chenjian2159老大, < 谢谢 ! >

zzl9105

xiaxiang 发表于 2011-3-24 12:13
这个程序可实现线，圆弧，多义线，圆，样条曲线等等的打断。
演示中只有线，其它的可自己试。

你好呀，我下载了，变成lisp程序后，加载不了，内里也不是什么程序，也没有显示命令名，这是怎么回事呀？我把部分文字贴出来：
<meta name="keywords" content="" />
<meta name="description" content=",明经通道" />
<meta name="generator" content="Discuz! X2" />
<meta name="author" content="Discuz! Team and Comsenz UI Team" />
<meta name="copyright" content="2001-2011 Comsenz Inc." />
<meta name="MSSmartTagsPreventParsing" content="True" />
<meta http-equiv="MSThemeCompatible" content="Yes" />
<base href="http://bbs.mjtd.com/" /><link rel="stylesheet" type="text/css" href="data/cache/style_1_common.css?B0m" /><link rel="stylesheet" type="text/css" href="data/cache/style_1_forum_attachment.css?B0m" /><script type="text/javascript">var STYLEID = '1', STATICURL = 'static/', IMGDIR = 'static/image/common', VERHASH = 'B0m', charset = 'gbk', discuz_uid = '0', cookiepre = 'ncjy_08db_', cookiedomain = '.mjtd.com', cookiepath = '/', showusercard = '1', attackevasive = '0', disallowfloat = 'newthread', creditnotice = '1|通道币|个,2|威望|,3|明经币|个,4|金钱|,5|贡献|,6|激情|', defaultstyle = '', REPORTURL = 'aHR0cDovL2Jicy5tanRkLmNvbS9mb3J1bS5waHA/bW9kPWF0dGFjaG1lbnQmYWlkPU5UZ3dPVEY4T0Rka05tVmxORGQ4TVRNeE9EVXdNVE13T1h3ek9UVTRNRGg4T0RVNU5EYyUzRA==', SITEURL = 'http://bbs.mjtd.com/', JSPATH = 'static/js/';</script>
<script src="static/js/common.js?B0m" type="text/javascript"></script><meta name="application-name" content="明经通道" />
<meta name="msapplication-tooltip" content="明经通道" />
<meta name="msapplication-task" content="name=首页;action-

害得我花了一个币，难道不是lisp程序？

mccad

zzl9105 发表于 2011-10-13 18:31
你好呀，我下载了，变成lisp程序后，加载不了，内里也不是什么程序，也没有显示命令名，这是怎么回事呀？ ...

下载的文件是LSP文件没错，你可重新下载试试，不重复扣币。

zzc83

以前好像看过一个英文版本的交点打断  很好用

gingko_sf

8错。值得拥有！