[功能] 批量联线

/db_自贡黄明儒_

1. dot http://bbs.xdcad.net/thread-677302-1-1.html

复制代码

2. 
   
3. ;;[功能] 批量联线  By 自贡黄明儒 2014.12.15
   
4. ;;det [url]http://bbs.xdcad.net/thread-677303-1-1.html[/url]
   
5. (defun C:MyJion        (/ E H J LST N OBJ P11 P12 P21 P22 SS X)
   
6.   (defun twoEnt        (e1 e2)
   
7.     (setq p11 (vlax-curve-getStartPoint e1))
   
8.     (setq p12 (vlax-curve-getEndPoint e1))
   
9.     (setq p21 (vlax-curve-getStartPoint e2))
   
10.     (setq p22 (vlax-curve-getEndPoint e2))
    
11.     (cond ((and (equal (det p11 p12 p21) 0) (equal (det p11 p12 p22) 0))
    
12.            (setq H (car (Max-distance (list p11 p12 p21 p22))))
    
13.            (setq obj (vlax-ename->vla-object e1))
    
14.            (vlax-put obj 'StartPoint (car H))
    
15.            (vlax-put obj 'EndPoint (cadr H))
    
16.            (entdel e2)
    
17.           )
    
18.     )
    
19.   )
    
20. 
    
21.   (cond
    
22.     ((setq ss (ssget '((0 . "LINE"))))
    
23.      (repeat (setq n (sslength ss))
    
24.        (setq e (ssname ss (setq n (1- n))))
    
25.        (setq lst (cons e lst))
    
26.      )
    
27.      (foreach j        lst
    
28.        (mapcar
    
29.          '(lambda (x) (cond ((and (not (equal x j)) (entget x) (entget j)) (twoEnt j x))))
    
30.          lst
    
31.        )
    
32.      )
    
33.     )
    
34.   )
    
35.   (princ)
    
36. )
    
37. 
    

<br /> ;;[功能] 批量联线  By 自贡黄明儒 2014.12.15<br /> ;;det [url]http://bbs.xdcad.net/thread-677303-1-1.html[/url]<br /> (defun C:MyJion        (/ E H J LST N OBJ P11 P12 P21 P22 SS X)<br />   (defun twoEnt        (e1 e2)<br />     (setq p11 (vlax-curve-getStartPoint e1))<br />     (setq p12 (vlax-curve-getEndPoint e1))<br />     (setq p21 (vlax-curve-getStartPoint e2))<br />     (setq p22 (vlax-curve-getEndPoint e2))<br />     (cond ((and (equal (det p11 p12 p21) 0) (equal (det p11 p12 p22) 0))<br />            (setq H (car (Max-distance (list p11 p12 p21 p22))))<br />            (setq obj (vlax-ename->vla-object e1))<br />            (vlax-put obj 'StartPoint (car H))<br />            (vlax-put obj 'EndPoint (cadr H))<br />            (entdel e2)<br />           )<br />     )<br />   )<br /> <br />   (cond<br />     ((setq ss (ssget '((0 . "LINE"))))<br />      (repeat (setq n (sslength ss))<br />        (setq e (ssname ss (setq n (1- n))))<br />        (setq lst (cons e lst))<br />      )<br />      (foreach j        lst<br />        (mapcar<br />          '(lambda (x) (cond ((and (not (equal x j)) (entget x) (entget j)) (twoEnt j x))))<br />          lst<br />        )<br />      )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br />

游客，如果您要查看本帖隐藏内容请回复

Lispboy

新写的啊，老黄，这么快。

amwkto2011

这动画怎么看着这么眼熟

wzg356

继续发扬光大

wzg356

请查一下？？倀愀椀爀 (list U V)

Lispboy

amwkto2011 发表于 2014-12-15 16:32
这动画怎么看着这么眼熟

他好像偷懒了

/db_自贡黄明儒_

Lispboy 发表于 2014-12-15 16:46
他好像偷懒了

看穿了呀

lucas3

这个是设容差的吗？

st788796

输入"合并直线"  或者 hbln 在论坛搜索可以扩展思路

zhangq_cai1

看看~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~··

819534890

学习一下，谢谢

HLCAD

回复看贴!谢谢!

/db_自贡黄明儒_

wzg356 发表于 2014-12-15 16:46
请查一下？？倀愀椀爀 (list U V)

下载文件吧，论坛总有点问题

杜流浪人

批量的处理都是好的

434939575

这个必须支持！