【求助】自动连接直线与圆

lansedi

小弟全部身家求助各位高手帮实现以下程序：
求助：功能要求
功已知文字（如图中111，222，333）与蓝色圆，框选直线文字与圆,则生成如图示PL线，能批量框选文字与圆。
命令提示步骤：
1、选择文字
2、选择圆(当批量框选圆后命令结束,程序完成PL线)

要求线左右超出文字高度的1/4,线偏离文字距离为字高的1/5
在框选后，程序能自动判断文字与就近圆相连
PL线指向圆心
PL线图层随文字图层

在此小弟先感谢各位好心的高手

nzl1116

lansedi 发表于 2013-9-5 21:43
这头像是巴神吧

1. (vl-load-com)
   
2. (defun GetBoundingBox (TextObj / MinPnt MaxPnt)
   
3.   (vla-GetBoundingBox TextObj 'MinPnt 'MaxPnt)
   
4.   (list        (vlax-safearray->list MinPnt)
   
5.         (vlax-safearray->list MaxPnt)
   
6.   )
   
7. )
   
8. (defun c:test (/ ss Lst0 Lst1 n Ent Data Pt0 Pt1 Pt2 Pt3 Pt4 PLst Ent0 H0 H1 Wid Hgt Dst0 Dst1)
   
9.   (if (setq ss (ssget '((0 . "Text,Circle"))))
   
10.     (progn
    
11.       (setq Lst0 nil Lst1 nil n 0)
    
12.       (repeat (sslength ss)
    
13.         (setq Ent (ssname ss n)
    
14.               n   (1+ n)
    
15.         )
    
16.         (if (= (cdr (assoc 0 (entget Ent))) "CIRCLE")
    
17.           (setq Lst1 (cons Ent Lst1))
    
18.           (setq Lst0 (cons Ent Lst0))
    
19.         )
    
20.       )
    
21.       (setq ss nil)
    
22.       (while (and Lst0 Lst1)
    
23.         (setq Data (GetBoundingBox (vlax-ename->vla-object (car Lst0)))
    
24.               Pt0  (car Data)
    
25.               Pt1  (cadr Data)
    
26.               Hgt  (- (cadr Pt1) (cadr Pt0))
    
27.               H0   (* Hgt 0.2)
    
28.               H1   (* Hgt 0.25)
    
29.               Wid  (- (car Pt1) (car Pt0))
    
30.               Pt3  (polar Pt0 pi H1)
    
31.               Pt3  (polar Pt3 (* pi 1.5) H0)
    
32.               PLst (list (cons 10 Pt3))
    
33.               Pt3  (polar Pt3 0 (+ Wid H1 H1))
    
34.               PLst (cons (cons 10 Pt3) PLst)
    
35.               Dst0 nil
    
36.               n    0
    
37.         )
    
38.         (repeat (length Lst1)
    
39.           (setq Ent  (nth n Lst1)
    
40.                 n    (1+ n)
    
41.                 Dst1 (distance (setq Pt4 (cdr (assoc 10 (entget Ent)))) Pt3)
    
42.           )
    
43.           (cond
    
44.             ((not Dst0) (setq Dst0 Dst1 Ent0 Ent Pt2 Pt4))
    
45.             ((< Dst1 Dst0) (setq Dst0 Dst1 Ent0 Ent Pt2 Pt4))
    
46.             (t nil)
    
47.           )
    
48.         )
    
49.         (setq Lst0 (cdr Lst0)
    
50.               Lst1 (vl-remove Ent0 Lst1)
    
51.               Pt3  (polar Pt3 (angle Pt3 Pt2) (- Dst0 (cdr (assoc 40 (entget Ent0)))))
    
52.               PLst (cons (cons 10 Pt3) PLst)
    
53.               PLst (apply 'append (mapcar '(lambda (x) (list x (cons 40 0) (cons 41 0))) PLst))
    
54.         )
    
55.         (entmakex
    
56.           (append '((0 . "LWPOLYLINE")
    
57.                     (100 . "AcDbEntity")
    
58.                     (67 . 0)
    
59.                     (410 . "Model")
    
60.                     (100 . "AcDbPolyline")
    
61.                     (8 . "0")
    
62.                     (70 . 0)
    
63.                    )
    
64.                   (list (cons 90 3))
    
65.                   PLst
    
66.           )
    
67.         )
    
68.       )
    
69.     )
    
70.   )
    
71.   (princ)
    
72. )

(vl-load-com)<br /> (defun GetBoundingBox (TextObj / MinPnt MaxPnt)<br />   (vla-GetBoundingBox TextObj 'MinPnt 'MaxPnt)<br />   (list        (vlax-safearray->list MinPnt)<br />         (vlax-safearray->list MaxPnt)<br />   )<br /> )<br /> (defun c:test (/ ss Lst0 Lst1 n Ent Data Pt0 Pt1 Pt2 Pt3 Pt4 PLst Ent0 H0 H1 Wid Hgt Dst0 Dst1)<br />   (if (setq ss (ssget '((0 . "Text,Circle"))))<br />     (progn<br />       (setq Lst0 nil Lst1 nil n 0)<br />       (repeat (sslength ss)<br />         (setq Ent (ssname ss n)<br />               n   (1+ n)<br />         )<br />         (if (= (cdr (assoc 0 (entget Ent))) "CIRCLE")<br />           (setq Lst1 (cons Ent Lst1))<br />           (setq Lst0 (cons Ent Lst0))<br />         )<br />       )<br />       (setq ss nil)<br />       (while (and Lst0 Lst1)<br />         (setq Data (GetBoundingBox (vlax-ename->vla-object (car Lst0)))<br />               Pt0  (car Data)<br />               Pt1  (cadr Data)<br />               Hgt  (- (cadr Pt1) (cadr Pt0))<br />               H0   (* Hgt 0.2)<br />               H1   (* Hgt 0.25)<br />               Wid  (- (car Pt1) (car Pt0))<br />               Pt3  (polar Pt0 pi H1)<br />               Pt3  (polar Pt3 (* pi 1.5) H0)<br />               PLst (list (cons 10 Pt3))<br />               Pt3  (polar Pt3 0 (+ Wid H1 H1))<br />               PLst (cons (cons 10 Pt3) PLst)<br />               Dst0 nil<br />               n    0<br />         )<br />         (repeat (length Lst1)<br />           (setq Ent  (nth n Lst1)<br />                 n    (1+ n)<br />                 Dst1 (distance (setq Pt4 (cdr (assoc 10 (entget Ent)))) Pt3)<br />           )<br />           (cond<br />             ((not Dst0) (setq Dst0 Dst1 Ent0 Ent Pt2 Pt4))<br />             ((< Dst1 Dst0) (setq Dst0 Dst1 Ent0 Ent Pt2 Pt4))<br />             (t nil)<br />           )<br />         )<br />         (setq Lst0 (cdr Lst0)<br />               Lst1 (vl-remove Ent0 Lst1)<br />               Pt3  (polar Pt3 (angle Pt3 Pt2) (- Dst0 (cdr (assoc 40 (entget Ent0)))))<br />               PLst (cons (cons 10 Pt3) PLst)<br />               PLst (apply 'append (mapcar '(lambda (x) (list x (cons 40 0) (cons 41 0))) PLst))<br />         )<br />         (entmakex<br />           (append '((0 . "LWPOLYLINE")<br />                     (100 . "AcDbEntity")<br />                     (67 . 0)<br />                     (410 . "Model")<br />                     (100 . "AcDbPolyline")<br />                     (8 . "0")<br />                     (70 . 0)<br />                    )<br />                   (list (cons 90 3))<br />                   PLst<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )

lansedi

自己顶一下，是不是这个功能太负责了？

lansedi

自己顶一下，是不是这个功能太复杂了？

nzl1116

lansedi 发表于 2013-9-5 21:03
自己顶一下，是不是这个功能太复杂了？

不复杂，就是体力活，文字是text还是mtext？

lansedi

nzl1116 发表于 2013-9-5 21:10
不复杂，就是体力活，文字是text还是mtext？

文字是text
真的不复杂么，这位前辈实在是太感谢了，我还以为很有挑战呢
有劳巴神幸苦一下，帮帮小弟

lansedi

nzl1116 发表于 2013-9-5 21:10
不复杂，就是体力活，文字是text还是mtext？

这头像是巴神吧

lansedi

nzl1116 发表于 2013-9-5 23:05

曼联和国米球迷，不过我喜欢也AC的巴神和卡卡，所以现在也在关注AC

lansedi

谢谢nzl1116 辛苦你了

香田里浪人

nzl1116 发表于 2013-9-5 20:12

请教阁下，我改了一下，可以连接多边形，就是将CIRCLE改为LWPOLYLINE，如何修改可以连接到多边形质心（中心）