[密技]：CAD中输入带圈的数字的办法

一丝冷风

　*运行宏 数变编号，加圆圈
Public Sub bh()
ThisDrawing.Utility.Prompt "请选择要加圆圈的文本" + vbCrLf
Dim sset As AcadSelectionSet
Dim gp(0) As Integer
Dim data(0) As Variant
If ThisDrawing.SelectionSets.Count <> 0 Then
For i = 0 To ThisDrawing.SelectionSets.Count - 1
Set sset = ThisDrawing.SelectionSets.Item(i)
sset.Delete
Next
Else
End If
Set sset = ThisDrawing.SelectionSets.Add("ss")
AcadApplication.Visible = True
gp(0) = 0
data(0) = "*Text"
123: sset.SelectOnScreen gp, data
Dim min As Variant
Dim max As Variant
Dim o(0 To 2) As Double
Dim cir As AcadCircle
If sset.Count < 1 Then
MsgBox "没选文本"
GoTo 123
End If
For i = 0 To sset.Count - 1
sset(i).GetBoundingBox min, max
o(0) = (min(0) + max(0)) / 2
o(1) = (min(1) + max(1)) / 2
o(2) = 0
ThisDrawing.ModelSpace.AddCircle o, 4.5
Next
End Sub

aichong

如何运行宏呀？

KENSHIN709

这个东东好用么？？象是带属性的文本，轴线上用的那种？？

大老板

好用吗

yshf

试试这个

2. 
   
3. ;;;by yshf
   
4. (defun c:cc()
   
5.    (vl-load-com)
   
6.    (if (progn (Prompt "\n请选择要加圆圈的文本")
   
7.               (setq ssa (ssget '((0 . "*TEXT")))))
   
8.        (while (setq ent (ssname ssa 0))
   
9.           (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
   
10.           (setq con (mapcar 'vlax-safearray->list (list minpt maxpt))
    
11.                 po  (mapcar '* '(0.5 0.5) (mapcar '+ (car con) (cadr con)))
    
12.                 ssa (ssdel ent ssa)
    
13.           )
    
14.           (entmake (list '(0 . "CIRCLE") (cons 10 po)
    
15.                           (cons 40 (distance po (car con)))))  
    
16.        )
    
17.        (alert "没有选择到任何文本!")
    
18.    )
    
19.    (princ)
    
20. )
    

<br /> ;;;by yshf<br /> (defun c:cc()<br />    (vl-load-com)<br />    (if (progn (Prompt "\n请选择要加圆圈的文本")<br />               (setq ssa (ssget '((0 . "*TEXT")))))<br />        (while (setq ent (ssname ssa 0))<br />           (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)<br />           (setq con (mapcar 'vlax-safearray->list (list minpt maxpt))<br />                 po  (mapcar '* '(0.5 0.5) (mapcar '+ (car con) (cadr con)))<br />                 ssa (ssdel ent ssa)<br />           )<br />           (entmake (list '(0 . "CIRCLE") (cons 10 po)<br />                           (cons 40 (distance po (car con)))))  <br />        )<br />        (alert "没有选择到任何文本!") <br />    )<br />    (princ)<br /> )<br />