尺寸标注的问题！

laoliu09

在对齐标注中，尺寸界线间的位置不够，我把fit属性设为acBestFit，但为什么还是一样，文字太宽的时候，它还是标在尺寸界线之间？奇怪！请教！是不是还有什么属性要设置的？

bai_cai101

Sub qingli()
Dim tuceng As AcadLayer
On Error Resume Next
If IsNull(ThisDrawing.Layers.Item("0")) Then
Set tuceng = ThisDrawing.Layers.Add("0")
tuceng.color = 7
tuceng.Lineweight = acLnWt035
End If If IsNull(ThisDrawing.Layers.Item("细线")) Then
Set tuceng = ThisDrawing.Layers.Add("细线")
tuceng.color = 1
tuceng.Lineweight = acLnWt013
End If
Dim SSset As AcadSelectionSet '建立选择集"SS1"
Dim enti As AcadEntity
If Not IsNull(ThisDrawing.SelectionSets.Item("SS1")) Then
Set SSset = ThisDrawing.SelectionSets.Item("SS1")
SSset.Delete
End If
Set SSset = ThisDrawing.SelectionSets.Add("SS1")
Dim filterType As Integer
Dim filterData As Variant
filterType = 8
For Each tuceng In ThisDrawing.Layers
filterType = tuceng.Name
SSset.Select acSelectionSetAll
For Each enti In SSset If enti.Layer = "0" Then '图层"0"
If tuceng.color = 7 Then
If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then
' MsgBox tuceng.Name & "," & enti.color
enti.color = 7
enti.Update
Else
'MsgBox tuceng.Name & "," & enti.color
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
ElseIf tuceng.color = 1 Then
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Update
Else
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
Else
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Update
Else
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
End If
'End If
ElseIf enti.Layer = "细线" Then '图层"细线"
If tuceng.color = 7 Then
If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then
MsgBox tuceng.Name & tuceng.color & enti.color
enti.color = 7
enti.Layer = "0"
enti.Update
Else
'MsgBox tuceng.Name & "," & enti.color
enti.color = 1
'enti.Layer = "细线"
enti.Update
End If
ElseIf tuceng.color = 1 Then
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Layer = "0"
enti.Update
Else
enti.color = 1
'enti.Layer = "细线"
enti.Update
End If
Else
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Layer = "0"
enti.Update
Else
enti.color = 1
'enti.Layer = "细线"
enti.Update
End If
End If
'End If
Else ' enti.Layer <> "细线" And enti.Layer <> "0" Then '图层"其它"
If tuceng.color = 7 Then
If enti.color = acByLayer Or enti.color = 7 Or enti.color = acByBlock Then
MsgBox tuceng.Name '& "," & enti.color
enti.color = 7
enti.Layer = "0"
enti.Update
Else
'MsgBox tuceng.Name & "," & enti.color
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
ElseIf tuceng.color = 1 Then
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Layer = "0"
enti.Update
Else
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
Else
If enti.color = 7 Or enti.color = acByBlock Then
enti.color = 7
enti.Layer = "0"
enti.Update
Else
enti.color = 1
enti.Layer = "细线"
enti.Update
End If
End If
End If Next enti
Next tuceng
For Each tuceng In ThisDrawing.Layers
If tuceng.Name = "0" Then
tuceng.color = 7
tuceng.Lineweight = acLnWt035
End If
If tuceng.Name = "细线" Then
tuceng.color = 1
tuceng.Lineweight = acLnWt013
End If
If tuceng.Name <> "0" And tuceng.Name <> "细线" And tuceng.Name <> "定义点" And tuceng.Name <> "Defpoints" Then
tuceng.Delete
End If
Next tuceng
SSset.clease
SSset.Delete End Sub

laoliu09

你什么意思啊？我问的问题你怎么给我这样一个解释呢？大家评评理！！！！！


我不明白你的意思啊！