请教阁下，我改了一下，可以连接多边形，就是将CIRCLE改为LWPOLYLINE，如何修改可以连接到多边形质心（中 ...
计算质心有点麻烦 nzl1116 发表于 2013-9-6 21:49 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:wzzdlj (/ 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,LWPOLYLINE"))))
(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))) "LWPOLYLINE")
(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)
) 浪人，自己顿悟了？！
页:
1
[2]