|
|
用VBA在图纸空间中标注的尺寸标注线型比例是1，而CAD的dli命令会自动修改这个标注线型比例的，用VBA如何自动修改这个标注线型比例呢，或者能得到当前视口的比例系数也可以啊！亲高手们指点。。。
代码如下：
Sub dli()
Dim dimObj As AcadDimRotated
Dim p1 As Variant
Dim p2 As Variant
Dim p3 As Variant
Dim rotAngle As Double
Dim rotAngleNunmer As Integer
rotAngleNunmer = 1
With ThisDrawing.Utility
p1 = (.GetPoint(, "请指定标注起始点(按Esc或Enter或左健退出):"))
If IsEmpty(p1) Then Exit Sub
End With
With ThisDrawing.Utility
p2 = (.GetPoint(, "请指定标注结束点(按Esc或Enter或左健退出):"))
If IsEmpty(p2) Then Exit Sub
End With
With ThisDrawing.Utility
p3 = (.GetPoint(, "请指定标注基准点(按Esc或Enter或左健退出):"))
If IsEmpty(p3) Then Exit Sub
End With
On Error Resume Next
If p1(0) p1(0) And p3(0) p1(1) And p3(1) > p2(1) Then 'p3点Y在p1 p2上方
rotAngleNunmer = 2
End If
End If
End If
If p1(0) > p2(0) Then 'p1点在右边
If p3(0) > p2(0) And p3(0) p1(1) And p3(1) > p2(1) Then 'p3点Y在p1 p2上方
rotAngleNunmer = 2
End If
End If
End If
If p2(1) > p1(1) Then 'p1点在下边
If p3(1) > p1(1) And p3(1) p1(0) And p3(0) > p2(0) Then 'p3点Y在p1 p2右方
rotAngleNunmer = 4
End If
End If
End If
If p1(1) > p2(1) Then 'p1点在上边
If p3(1) > p2(1) And p3(1) p1(0) And p3(0) > p2(0) Then 'p3点Y在p1 p2右方
rotAngleNunmer = 4
End If
End If
End If
Select Case rotAngleNunmer
Case 1, 2
rotAngle = 0
Case 3, 4
rotAngle = 90
End Select
rotAngle = rotAngle * 3.141592 / 180# ' covert to Radians
If ThisDrawing.ActiveSpace = acPaperSpace Then '当前为图纸空间
Set dimObj = ThisDrawing.PaperSpace.AddDimRotated(p1, p2, p3, rotAngle)
Else
Set dimObj = ThisDrawing.ModelSpace.AddDimRotated(p1, p2, p3, rotAngle)
End If
dimObj.Layer = "标注"
ThisDrawing.SendCommand "dco" & vbCr
End Sub |
|
置顶卡
