如何画一个圆后自动在中心输出面积，然后面积和圆联动高亮

张腾之

画一个圆后自动在圆心输出面积text，然后这个text和circle无论选中哪个都是二者一起高亮显示

csharp

group         

marting

1. (defun XD::Group:Make (name ss / c d e ents f i)
   
2.   (setq c    (list (cons 0 "GROUP") (cons 100 "AcDbGroup"))
   
3.         ents nil
   
4.         d    (list (cons 70 0) (cons 71 1))
   
5.   )
   
6.   (cond ((= (type ss) 'LIST) (setq ents ss))
   
7.         ((= (type ss) 'PICKSET)
   
8.          (setq i -1)
   
9.          (repeat (sslength ss)
   
10.            (setq ents (cons (ssname ss (setq i (1+ i))) ents))
    
11.          )
    
12.         )
    
13.   )
    
14.   (setq i -1)
    
15.   (repeat (length ents)
    
16.     (setq c (append c (list (cons 340 (nth (setq i (1+ i)) ents)))))
    
17.   )
    
18.   (setq c (append c d)
    
19.         e (entmakex c)
    
20.         f (dictsearch (namedobjdict) "ACAD_GROUP")
    
21.   )
    
22.   (dictadd (cdr (assoc -1 f)) name e)
    
23. )
    
24. (defun _AddText (textString insertionPoint height / acadObj acAlignmentCenter doc modelSpace textObj)
    
25.   (setq acadObj (vlax-get-acad-object))
    
26.   (setq doc (vla-get-ActiveDocument acadObj))
    
27.   (setq modelSpace (vla-get-ModelSpace doc))
    
28.   (setq
    
29.     textObj (vla-AddText modelSpace textString insertionPoint height)
    
30.   )
    
31.   (vla-put-Alignment textObj acAlignmentCenter)
    
32.   (vla-put-TextAlignmentPoint textObj insertionPoint)
    
33.   textobj
    
34. )
    
35. (defun c:tt ()
    
36.   (prompt "\n拾取園<退出>:")
    
37.   (if (setq e (ssget ":S:E" '((0 . "CIRCLE"))))
    
38.     (progn (setq e       (ssname e 0)
    
39.                  obj     (vlax-ename->vla-object e)
    
40.                  #area   (vla-get-area obj)
    
41.                  #center (vla-get-center obj)
    
42.            )
    
43.            (_addtext (rtos #area 2 2) #center 3.5)
    
44.            (xd::group:make "abc" (list e (entlast)))
    
45.            (setvar "pickstyle" 1)
    
46.     )
    
47.   )
    
48.   (princ)
    
49. )
    

(defun XD::Group:Make (name ss / c d e ents f i)<br />   (setq c    (list (cons 0 "GROUP") (cons 100 "AcDbGroup"))<br />         ents nil<br />         d    (list (cons 70 0) (cons 71 1))<br />   )<br />   (cond ((= (type ss) 'LIST) (setq ents ss))<br />         ((= (type ss) 'PICKSET)<br />          (setq i -1)<br />          (repeat (sslength ss)<br />            (setq ents (cons (ssname ss (setq i (1+ i))) ents))<br />          )<br />         )<br />   )<br />   (setq i -1)<br />   (repeat (length ents)<br />     (setq c (append c (list (cons 340 (nth (setq i (1+ i)) ents)))))<br />   )<br />   (setq c (append c d)<br />         e (entmakex c)<br />         f (dictsearch (namedobjdict) "ACAD_GROUP")<br />   )<br />   (dictadd (cdr (assoc -1 f)) name e)<br /> )<br /> (defun _AddText (textString insertionPoint height / acadObj acAlignmentCenter doc modelSpace textObj)<br />   (setq acadObj (vlax-get-acad-object))<br />   (setq doc (vla-get-ActiveDocument acadObj))<br />   (setq modelSpace (vla-get-ModelSpace doc))<br />   (setq<br />     textObj (vla-AddText modelSpace textString insertionPoint height)<br />   )<br />   (vla-put-Alignment textObj acAlignmentCenter)<br />   (vla-put-TextAlignmentPoint textObj insertionPoint)<br />   textobj<br /> )<br /> (defun c:tt ()<br />   (prompt "\n拾取園<退出>:")<br />   (if (setq e (ssget ":S:E" '((0 . "CIRCLE"))))<br />     (progn (setq e       (ssname e 0)<br />                  obj     (vlax-ename->vla-object e)<br />                  #area   (vla-get-area obj)<br />                  #center (vla-get-center obj)<br />            )<br />            (_addtext (rtos #area 2 2) #center 3.5)<br />            (xd::group:make "abc" (list e (entlast)))<br />            (setvar "pickstyle" 1)<br />     )<br />   )<br />   (princ)<br /> )<br />

张腾之

csharp 发表于 2017-3-8 17:30

group？？可否详细一些

newer

张腾之 发表于 2017-3-9 08:01

3楼matring代码都给你写了，还要完整？

张腾之

newer 发表于 2017-3-9 09:21

嗯，试了试可以