替代acad中的文本
你好，另一个问题。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
End Sub
thx
**** Hidden Message *****
喜欢这个？
Option Explicit
Const DEFAULT_OFFSET = 7
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)
lineObject.Update
End Sub
Sub test()
'draw Line
Call line(-5000, -8000, 5000, 3000)
' draw a dimension
Call dimension(-5000, -8000, 5000, 3000, 4900, 7900, , "Test")
End Sub
提示 除非您有原因不1原因，否则声明您的参数类型
可以有一个可选参数（如示例中所示），因为类型定义将导致这些参数的默认值赋值。
如果决定省略这些可选参数的类型，请确保在子/函数中实现严肃的类型验证 谢谢你，Dnereb
你帮了我很多忙
页:
[1]