你好,另一个问题。Vba使用此代码在acad中绘制一条线,并在其后添加尺寸。我想覆盖文本并将SH =放在它的前面。这些都可以,但是在下一行的维度中,我想把SD =放在它前面。我如何在下面“校准尺寸”行中输入文本覆盖?可能吗?这将使我的代码小很多
子维度(x1,y1,x2,y2,x3,y3)
Dim Dim object As AcadDimAligned
Dim startpnt(0到2) As Double
Dim endpnt(0到2)As Double
Dim text position(0到2)As Double
startpnt(0)= x1
startpnt(1)= y1
startpnt(2)= 0
endpnt(0)= x2model space . AddDimAligned(start pnt,endpnt,text position)
dimension object。TextOverride = " SH = " '
我想更改SH
dimensionObject。arrow head size = 180
dimension object。text height = 180 dimension object。extension line Offset = Offset
dimension object。color = acCyan
dimension object。更新
End Sub
' line input
Sub line(x1,y1,x2,y2)
Dim startpnt(0到2) As Double
Dim endpnt(0到2)As Double
Dim line Object As Object
start pnt(0)= x1
start pnt(1)= y1
start pnt(2)= 0
End pnt(0)= x2
End pnt(1)= y2
End pnt(2)=。ModelSpace.AddLine(startpnt,endpnt)
lineObject。更新
End Sub
Sub test()
' draw Line
Call Line(5000,8000,5000,3000)
' draw a dimension
Call dimension(5000,8000,5000,3000,4900,7900)
In here
Sub dimension(x1 As Long, y1 As Long, x2 As Long, y2 As Long, x3 As Long, y3 As Long, Optional OffsetDistance As Long, Optional OverideText As String, Optional Offset, Optional DimColor)
Dim dimensionObject As AcadDimAligned
Dim EndPnt(0 To 2) As Double
Dim StartPnt(0 To 2) As Double
Dim TextPosition(0 To 2) As Double
If IsMissing(OverideText) Then OverideText = ""
If IsMissing(Offset) Then Offset = DEFAULT_OFFSET
If IsMissing(DimColor) Then DimColor = acByBlock
StartPnt(0) = x1
StartPnt(1) = y1
StartPnt(2) = 0
EndPnt(0) = x2
EndPnt(1) = y2
EndPnt(2) = 0
TextPosition(0) = x3
TextPosition(1) = y3
TextPosition(2) = 0
Set dimensionObject = ThisDrawing.ModelSpace.AddDimAligned(StartPnt, EndPnt, TextPosition)
dimensionObject.TextOverride = OverideText
dimensionObject.ArrowheadSize = 180
dimensionObject.TextHeight = 180
dimensionObject.ExtensionLineOffset = Offset
dimensionObject.Color = DimColor
dimensionObject.Update
End Sub
Sub line(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
Dim StartPnt(0 To 2) As Double
Dim EndPnt(0 To 2) As Double
Dim lineObject As Object
StartPnt(0) = x1
StartPnt(1) = y1
StartPnt(2) = 0
EndPnt(0) = x2
EndPnt(1) = y2
EndPnt(2) = 0
Set lineObject = ThisDrawing.ModelSpace.AddLine(StartPnt, EndPnt)