【已解决】框选图块，自动画线连接图块插入点的工具（感谢Gu_xl 版主的热情帮助）

daidong013

求可以框选图块，自动画线连接图块插入点的工具！~~

这里有一个caoyin版主以前做的类似工具只能点选一并发上做个参考！~

Gu_xl

回复 daidong013 的帖子

1. (defun c:tt(/ os ss pl p1 p2)
   
2.   (setq os (getvar 'osmode))
   
3.   (setvar 'osmode 0)
   
4.   (setq ss (ssget '((0 . "insert"))))
   
5.   (if ss
   
6.     (progn
   
7.       (setq pl (GXL-GETSSBOX ss)
   
8.             p1 (car pl)
   
9.             p2 (cadr pl)
   
10.             ss (GXL-SEL-SS->LIST ss)
    
11.             )
    
12.     ;;;此处画一个圆，图块投影到园上排序
    
13.       (command "_pline" p1 "a" "s" (list (car p1) (cadr p2)) p2 "s" (list (car p2) (cadr p1)) p1 "")
    
14.       (setq en (entlast))
    
15.       (setq ss (vl-sort ss '(lambda (a b)
    
16.                            (< (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf a 10)))
    
17.                               (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf b 10)))
    
18.                               )
    
19.                            )
    
20.                         )
    
21.             )
    
22.         (command "_pline")
    
23.         (mapcar 'command (mapcar '(lambda (X) (gxl-dxf x 10)) ss))
    
24.       (command "")
    
25.       (entdel en)
    
26.       )
    
27.     )
    
28.   (setvar 'osmode os)
    
29.   (princ)
    
30.   )
    
31. ;; gxl-GetssBox 取得选择集的实体外矩形框
    
32. (defun gxl-GetssBox        (ss / maxpt maxptlst minpt minptlst obj x ss1)
    
33.   (setq ss1 (gxl-Sel-SS->List ss))
    
34.   (foreach x ss1
    
35.     (setq obj (vlax-ename->vla-object x))
    
36.     ;(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    
37.     ;(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
    
38.     (vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框
    
39.     (setq minPt (vlax-safearray->list minPt))
    
40.     (setq maxPt (vlax-safearray->list maxPt))
    
41.     (setq minPtlst (append minPtlst (list minPt)))
    
42.     (setq maxPtlst (append maxPtlst (list maxPt)))
    
43.   ) ;_ 结束foreach
    
44.   (setq        minPt (list (apply 'min (mapcar 'car minPtlst))
    
45.                     (apply 'min (mapcar 'cadr minPtlst))
    
46.                     0
    
47.               ) ;_ 结束list
    
48.   ) ;_ 结束setq
    
49.   (setq        maxPt (list (apply 'max (mapcar 'car maxPtlst))
    
50.                     (apply 'max (mapcar 'cadr maxPtlst))
    
51.                     0
    
52.               ) ;_ 结束list
    
53.   ) ;_ 结束setq
    
54.   ;(command "rectang" minPt maxPt)
    
55. (list minPt maxPt)
    
56. ) ;_ 结束defun
    
57. 
    
58. (defun gxl-Sel-SS->List        (ss / i s )
    
59.     (if ss
    
60.   (repeat (setq i (sslength ss))
    
61.   (setq s (cons (ssname ss (setq i (1- i))) s))
    
62.     )
    
63.     )
    
64. )
    
65. ;;;==================================================================
    
66. ;;;(gxl-dxf ent i )取出图元索引i对应的值
    
67. ;;;==================================================================
    
68.   (defun gxl-dxf (ent i)
    
69.     (cond ((= (type ent) 'ename)
    
70.             (cdr (assoc i (entget ent)))
    
71.              )
    
72.           ((= (type ent) 'list)
    
73.            (cdr (assoc i ent))
    
74.            )
    
75.     ) ;_ if
    
76.   )
    
77. 
    

(defun c:tt(/ os ss pl p1 p2)<br />   (setq os (getvar 'osmode))<br />   (setvar 'osmode 0)<br />   (setq ss (ssget '((0 . "insert"))))<br />   (if ss<br />     (progn<br />       (setq pl (GXL-GETSSBOX ss)<br />             p1 (car pl)<br />             p2 (cadr pl)<br />             ss (GXL-SEL-SS->LIST ss)<br />             )<br />     ;;;此处画一个圆，图块投影到园上排序<br />       (command "_pline" p1 "a" "s" (list (car p1) (cadr p2)) p2 "s" (list (car p2) (cadr p1)) p1 "")<br />       (setq en (entlast))<br />       (setq ss (vl-sort ss '(lambda (a b)<br />                            (< (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf a 10)))<br />                               (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf b 10)))<br />                               )<br />                            )<br />                         )<br />             )<br />         (command "_pline")<br />         (mapcar 'command (mapcar '(lambda (X) (gxl-dxf x 10)) ss))<br />       (command "")<br />       (entdel en)<br />       )<br />     )<br />   (setvar 'osmode os)<br />   (princ)<br />   )<br /> ;; gxl-GetssBox 取得选择集的实体外矩形框<br /> (defun gxl-GetssBox        (ss / maxpt maxptlst minpt minptlst obj x ss1)<br />   (setq ss1 (gxl-Sel-SS->List ss))<br />   (foreach x ss1<br />     (setq obj (vlax-ename->vla-object x))<br />     ;(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />     ;(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />     (vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框<br />     (setq minPt (vlax-safearray->list minPt))<br />     (setq maxPt (vlax-safearray->list maxPt))<br />     (setq minPtlst (append minPtlst (list minPt)))<br />     (setq maxPtlst (append maxPtlst (list maxPt)))<br />   ) ;_ 结束foreach<br />   (setq        minPt (list (apply 'min (mapcar 'car minPtlst))<br />                     (apply 'min (mapcar 'cadr minPtlst))<br />                     0<br />               ) ;_ 结束list<br />   ) ;_ 结束setq<br />   (setq        maxPt (list (apply 'max (mapcar 'car maxPtlst))<br />                     (apply 'max (mapcar 'cadr maxPtlst))<br />                     0<br />               ) ;_ 结束list<br />   ) ;_ 结束setq<br />   ;(command "rectang" minPt maxPt)<br /> (list minPt maxPt)<br /> ) ;_ 结束defun<br /> <br /> (defun gxl-Sel-SS->List        (ss / i s )<br />     (if ss<br />   (repeat (setq i (sslength ss))<br />   (setq s (cons (ssname ss (setq i (1- i))) s))<br />     )<br />     )<br /> )<br /> ;;;==================================================================<br /> ;;;(gxl-dxf ent i )取出图元索引i对应的值<br /> ;;;==================================================================<br />   (defun gxl-dxf (ent i)<br />     (cond ((= (type ent) 'ename)<br />             (cdr (assoc i (entget ent)))<br />              )<br />           ((= (type ent) 'list)<br />            (cdr (assoc i ent))<br />            )<br />     ) ;_ if<br />   )<br /> <br />

yjr111

Gu_xl 发表于 2012-4-15 23:09
找yjr111 ，他已经写好了哦！

托G版的福，的确写好了，我会给他发过去。
另外G版的与线平齐程序一直在用（自己写的还是不顺手啊），当所选物体图层或对齐线图层有线宽时就自动显示线宽了，能不能修改一下，不显示线宽？谢谢！

孙海波

yjr111 发表于 2012-4-15 23:36
托G版的福，的确写好了，我会给他发过去。
另外G版的与线平齐程序一直在用（自己写的还是不顺手啊），当 ...

请问可以发一份给我吗？

daidong013

坐在沙发上！~~等！！！！！~~~

daidong013

坐在板凳上！~等！~~等！~~~

daidong013

只能坐到地板上了！~~

egos

框选的话 插入点的连接顺序不好判断啊

daidong013

回复 Gu_xl 的帖子

就是这样的效果，真的太感谢版主了！~~

yjr111

版主真是太牛人！

edsion24

如果连接夹点呢 呵呵 ？请斑竹 继续出招。。。

jicqj

测试了一下  太强大了