[VBA程序]：请问怎样用VBA取得尺寸的值并编辑？谢谢

bosssy

请问怎样用VBA取得尺寸的值并编辑？谢谢

雪山飞狐(lzh)

取尺寸值有点麻烦，可以调用Vlax类实现
Sub tt()
Dim objVlax As New Vlax
Dim obj As Object, pnt
ThisDrawing.Utility.GetEntity obj, pnt
blkname = objVlax.EvalLispExpression("(cdr(assoc 2 (entget(handent """ + obj.Handle + """))))")
For Each i In ThisDrawing.Blocks(blkname)
If i.ObjectName = "AcDbMText" Then
MsgBox i.TextString
Exit For
End If
Next i
End Sub
设置的话直接对TextOverride属性赋值

gjliang

这是我写的，试试看！
Sub DE()
Dim ss As AcadSelectionSet
Set ss = GetSelSet
Dim ent As AcadEntity
For Each ent In ss
Dim S As String
On Error GoTo errtap
Dim a As String
a = ent.Measurement
S = ThisDrawing.Utility.GetString(False, "输入新尺寸文本" + "<" + a + "mm" + ">" + ":")
'If TypeOf ent Is AcadEntity Then
ent.TextOverride = S
'End If
ThisDrawing.SetVariable "filedia", 1
Next
errtap:
Exit Sub
End Sub
Function GetSelSet() As AcadSelectionSet
    Dim ss As AcadSelectionSet
    Dim ssName As String
    ssName = "PICKFIRST"
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets.Add(ssName)
    If Err Then
        Set ss = ThisDrawing.SelectionSets(ssName)
        ss.Delete
    End If
    Set ss = ThisDrawing.PickfirstSelectionSet
    If ss.Count = 0 Then
        Set ss = ThisDrawing.SelectionSets(ssName)
        If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
        ss.Clear
        ss.SelectOnScreen
    End If
    Set GetSelSet = ss
    ThisDrawing.SetVariable "filedia", 1
End Function

fenny_5

楼主要的是不是这个？
Dim Position As Integer
    Position = InStr(1, InStr(1, AcadDimObj.measurement), ".")
    AcadDimObj.textoverride = "{\fgdt;n}" & Left(CStr(AcadDimObj.measurement), Position + 3) & "{\H0.7x;±0.1 }"

pfrao

如何实现图形不动,标注每次读取txt文档中的数据自动标注?