TheSwamp

Code Red => VB(A) => Topic started by: wessel on December 09, 2005, 05:48:49 AM

Title: override text in acad
Post 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

Title: Re: override text in acad
Post by: wessel on December 09, 2005, 06:28:06 AM
btw. vba doesn't have the linear dim style. Does someone have a code to use it anyway
Title: Re: override text in acad
Post by: Dnereb on December 09, 2005, 08:58:27 AM

Like this?

Code: [Select]
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
Title: Re: override text in acad
Post by: wessel on December 14, 2005, 08:28:48 AM
thank you, Dnereb

you helped me alot