TheSwamp
Code Red => VB(A) => Topic started by: wessel on December 09, 2005, 05:48:49 AM
-
hello one other question. Vba draws a line in acad with this code and adds the dimension after that. I want to override the text and put SH = in front of it. That all works but in the dimension of the next line i want to put SD = in front of it. How can i input that text override in the "cal dimension" line below. Is it possible? it will keep my code a lot smaller
Sub dimension(x1, y1, x2, y2, x3, y3)
Dim dimensionObject As AcadDimAligned
Dim startpnt(0 To 2) As Double
Dim endpnt(0 To 2) As Double
Dim textPosition(0 To 2) As Double
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 = " SH = <> " '<----------------------------I want to change the SH
dimensionObject.ArrowheadSize = 180
dimensionObject.TextHeight = 180
dimensionObject.ExtensionLineOffset = Offset
dimensionObject.Color = acCyan
dimensionObject.Update
End Sub
'line input
Sub line(x1, y1, x2, y2)
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) <----------------------------- In here
End Sub
thx
-
btw. vba doesn't have the linear dim style. Does someone have a code to use it anyway
-
Like this?
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
Tips Declare your argument types unless you have a reason not to
1 reason can be having an optional argument (like in the example) because the type definition will cause a default value assignment for these arguments.
If you decide to omit the type of these optional arguments be sure to implement serious type validation in your sub/function
-
thank you, Dnereb
you helped me alot