lansedi 发表于 2013-9-5 20:12:02

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

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

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

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



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

lansedi 发表于 2013-9-5 21:43 static/image/common/back.gif
这头像是巴神吧

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

lansedi 发表于 2013-9-5 21:02:47

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

lansedi 发表于 2013-9-5 21:03:27

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

nzl1116 发表于 2013-9-5 21:10:20

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

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

lansedi 发表于 2013-9-5 21:42:49

nzl1116 发表于 2013-9-5 21:10 static/image/common/back.gif
不复杂，就是体力活，文字是text还是mtext？

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

lansedi 发表于 2013-9-5 21:43:49

nzl1116 发表于 2013-9-5 21:10 static/image/common/back.gif
不复杂，就是体力活，文字是text还是mtext？

这头像是巴神吧

lansedi 发表于 2013-9-5 23:26:06

nzl1116 发表于 2013-9-5 23:05 static/image/common/back.gif


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

lansedi 发表于 2013-9-5 23:26:41

谢谢nzl1116 辛苦你了

香田里浪人 发表于 2013-9-6 21:14:35

nzl1116 发表于 2013-9-5 20:12 static/image/common/back.gif


请教阁下，我改了一下，可以连接多边形，就是将CIRCLE改为LWPOLYLINE，如何修改可以连接到多边形质心（中心）
页: [1] 2
查看完整版本: 【求助】自动连接直线与圆