Create and Apply DimensionStyle Example (VBA)

'-------------------------------------------------------------
' Preconditions:
' 1. Create a VBA macro in a software product in which VBA is
'    embedded.
' 2. Copy and paste this example into the Visual Basic IDE.
' 3. Add a reference to the DraftSight type library,
'    install_dir\bin\dsAutomation.dll
' 4. Open the Immediate window.
' 5. Start DraftSight and open a document.
' 6. Run the macro.
'
' Postconditions:
' 1. A new DimensionStyle named SampleDimStyle is created and
'    activated.
' 2. Arc length, jogged, rotated, radius, and diameter dimensions
'    are created for circles, arcs, and a line, using the new
'    DimensionStyle.
' 3. Examine the Immediate window and the drawing.
'------------------------------------------------------------
Option Explicit
    Sub main()
        Dim dsApp As DraftSight.Application        

        'Connect to DraftSight application
        Set dsApp = GetObject(, "DraftSight.Application")
        'Abort any command currently running in DraftSight 
        'to avoid nested commands
        dsApp.AbortRunningCommand

        'Get active document
        Dim dsDoc As DraftSight.Document
        Set dsDoc = dsApp.GetActiveDocument()
        If dsDoc Is Nothing Then
            MsgBox ("There are no open documents in DraftSight.")
            Return
        End If        

        'Get DimensionStyle manager
        Dim dsDimStyleManager As DraftSight.DimensionStyleManager
        Set dsDimStyleManager = dsDoc.GetDimensionStyleManager()        

        'Create DimensionStyle named SampleDimStyle
        Dim createDimStyleResult As dsCreateObjectResult_e
        Dim dimStyleName As String
        dimStyleName = "SampleDimStyle"
        Dim dsDimStyle As DraftSight.DimensionStyle
        dsDimStyleManager.CreateDimensionStyle dimStyleName, dsDimStyle, createDimStyleResult
        Select Case True
            Case (dsCreateObjectResult_e.dsCreateObjectResult_Error = createDimStyleResult), dsCreateObjectResult_e.dsCreateObjectResult_AlreadyExists = createDimStyleResult, dsDimStyle Is Nothing
                MsgBox ("Failed to create " & dimStyleName & " DimensionStyle, or DimensionStyle already exists.")
                Exit Sub
        End Select        

        SetDimensionStyleSettings dsDimStyle

        'Activate DimensionStyle
        dsDimStyle.Activate        

        'Get model space
        Dim dsModel As DraftSight.Model
        Set dsModel = dsDoc.GetModel()        

        'Get sketch manager
        Dim dsSketchMgr As DraftSight.SketchManager
        Set dsSketchMgr = dsModel.GetSketchManager()        

        'Draw arc length Dimension
        DrawArcLengthDimension dsSketchMgr        

        'Draw jogged Dimension for circle and arc
        DrawJoggedDimension dsSketchMgr        

        'Draw rotated Dimension
        DrawRotatedDimension dsSketchMgr        

        'Draw radius Dimension for circle and arc
        DrawRadialDimension dsSketchMgr        

        'Draw diameter Dimension for circle and arc
        DrawDiameterDimension dsSketchMgr        

        'Zoom to fit
        dsApp.Zoom dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing
    End Sub

    Sub SetDimensionStyleSettings(ByVal dsDimStyle As DimensionStyle)
        'Get DimensionStyle arrows options
        Dim dsArrowsDimStyleOptions As DraftSight.DimensionStyleArrowsOptions
        Set dsArrowsDimStyleOptions = dsDimStyle.GetDimensionStyleArrowsOptions()        

        'Set start and end arrow types
        dsArrowsDimStyleOptions.SetStartArrow dsDimensionArrowType_e.dsDimensionArrowType_ClosedBlank, ""
        dsArrowsDimStyleOptions.SetEndArrow dsDimensionArrowType_e.dsDimensionArrowType_ClosedBlank, ""        

        'Get DimensionStyle line options
        Dim dsLineDimStyleOptions As DraftSight.DimensionStyleLineOptions
        Set dsLineDimStyleOptions = dsDimStyle.GetDimensionStyleLineOptions()        

        'Set Dimension line color
        Dim dsColor As DraftSight.Color
        Set dsColor = dsLineDimStyleOptions.DimensionLineColor
        dsColor.SetNamedColor dsNamedColor_e.dsNamedColor_Green
        dsLineDimStyleOptions.DimensionLineColor = dsColor        

        'Set extension line color
        dsColor.SetNamedColor dsNamedColor_e.dsNamedColor_Yellow
        dsLineDimStyleOptions.ExtensionLineColor = dsColor        

        'Get DimensionStyle radius and diameter Dimension options
        Dim dsRadialAndDiameterDimStyleOptions As DraftSight.DimensionStyleRadialDiameterDimensionOptions
        Set dsRadialAndDiameterDimStyleOptions = dsDimStyle.GetDimensionStyleRadialDiameterDimensionOptions()        

        'Set jog angle 45 degrees (in radians)
        dsRadialAndDiameterDimStyleOptions.RadiusDimensionJogAngle = 3.14159265358979 / 4        

        'Set center mark
        Dim markSize As Double
        markSize = 0.05
        dsRadialAndDiameterDimStyleOptions.SetCenterMarkDisplay dsDimensionCenterMarkDisplay_e.dsDimensionCenterMarkDisplay_AsMark, markSize        

        'Get Dimension style text options
        Dim dsTextOptions As DraftSight.DimensionStyleTextOptions
        Set dsTextOptions = dsDimStyle.GetDimensionStyleTextOptions()        

        'Frame Dimension text
        dsTextOptions.FrameDimensionText = True        

        'Set text position
        dsTextOptions.HorizontalPosition = dsDimensionTextHorizontalPosition_e.dsDimensionTextHorizontalPosition_Centered
        dsTextOptions.VerticalPosition = dsDimensionTextVerticalPosition_e.dsDimensionTextVerticalPosition_Centered        

        'Set text alignment
        dsTextOptions.Alignment = dsDimensionTextAlignment_e.dsDimensionTextAlignment_AlignWithDimensionLines
    End Sub

    Sub DrawArcLengthDimension(ByVal dsSketchMgr As DraftSight.SketchManager)
        'Add arc to drawing
        Dim centerX As Double
        centerX = -8
        Dim centerY As Double
        centerY = 1
        Dim centerZ As Double
        centerZ = 0
        Dim radius As Double
        radius = 5
        Dim startAngle As Double
        startAngle = 3.14159265358979 / 6
        Dim endAngle As Double
        endAngle = 3.14159265358979
        Dim dsArc As DraftSight.CircleArc
        Set dsArc = dsSketchMgr.InsertArc(centerX, centerY, centerZ, radius, startAngle, endAngle)        

        'Add arc length Dimension
        Dim dimensionPosition(2) As Double
        dimensionPosition(0) = -6
        dimensionPosition(1) = 6
        dimensionPosition(2) = 0
        Dim dimensionTextOverride As String
        dimensionTextOverride = ""
        Dim dsArcLengthDim As DraftSight.ArcLengthDimension
        Set dsArcLengthDim = dsSketchMgr.InsertArcLengthDimension(dsArc, dimensionPosition, dimensionTextOverride)        

        'Print information about arc length Dimension
        PrintArcLengthDimProperties dsArcLengthDim        

        'Add a partial arc length Dimension
        Dim firstPoint(2) As Double
        firstPoint(0) = -4
        firstPoint(1) = 3
        firstPoint(2) = 0
        Dim secondPoint(2) As Double
        secondPoint(0) = -7
        secondPoint(1) = 6
        secondPoint(2) = 0
        dimensionPosition(0) = -6
        dimensionPosition(1) = 7
        Dim dsArcLengthPartialDim As DraftSight.ArcLengthDimension
        Set dsArcLengthPartialDim = dsSketchMgr.InsertArcLengthDimensionPartial(dsArc, firstPoint, secondPoint, dimensionPosition, dimensionTextOverride)        

        'Print information about partial arc length Dimension
        PrintArcLengthDimProperties dsArcLengthDim
    End Sub

    Sub DrawJoggedDimension(ByVal dsSketchMgr As DraftSight.SketchManager)
        'Draw a circle
        Dim centerX As Double
        centerX = -7
        Dim centerY As Double
        centerY = -5
        Dim centerZ As Double
        centerZ = 0
        Dim radius As Double
        radius = 3
        Dim dsCircle As DraftSight.Circle
        Set dsCircle = dsSketchMgr.InsertCircle(centerX, centerY, centerZ, radius)        

        'Add jogged Dimension to circle
        Dim centerPositionOverride(2) As Double
        centerPositionOverride(0) = -12
        centerPositionOverride(1) = -8
        centerPositionOverride(2) = 0
        Dim jogLinePosition(2) As Double
        jogLinePosition(0) = -11
        jogLinePosition(1) = -8
        jogLinePosition(2) = 0
        Dim dimensionPosition(2) As Double
        dimensionPosition(0) = -10
        dimensionPosition(1) = -7.5
        dimensionPosition(2) = 0
        Dim dimensionTextOverride As String
        dimensionTextOverride = ""
        Dim dsJoggedDimForCircle As DraftSight.JoggedDimension
        Set dsJoggedDimForCircle = dsSketchMgr.InsertJoggedDimensionCircle(dsCircle, centerPositionOverride, jogLinePosition, dimensionPosition, dimensionTextOverride)        

        'Print information about jogged Dimension
        PrintJoggedDimProperties dsJoggedDimForCircle        

        'Draw an arc
        centerX = 2
        centerY = -6
        Dim arcRadius As Double
        arcRadius = 3
        Dim startAngle As Double
        startAngle = 0#
        Dim endAngle As Double
        endAngle = 3.14159265358979 / 3
        Dim dsArc As DraftSight.CircleArc
        Set dsArc = dsSketchMgr.InsertArc(centerX, centerY, centerZ, arcRadius, startAngle, endAngle)        

        'Add jogged Dimension to arc
        centerPositionOverride(0) = 7
        centerPositionOverride(1) = -3
        jogLinePosition(0) = 7
        jogLinePosition(1) = -4
        dimensionPosition(0) = 5.5
        dimensionPosition(1) = -4.5
        Dim dsJoggedDimForArc As DraftSight.JoggedDimension
        Set dsJoggedDimForArc = dsSketchMgr.InsertJoggedDimensionArc(dsArc, centerPositionOverride, jogLinePosition, dimensionPosition, dimensionTextOverride)        

        'Print information about jogged Dimension
        PrintJoggedDimProperties dsJoggedDimForArc
    End Sub

    Sub DrawRadialDimension(ByVal dsSketchMgr As DraftSight.SketchManager)
        'Draw a circle
        Dim centerX As Double
        centerX = 2
        Dim centerY As Double
        centerY = 2
        Dim centerZ As Double
        centerZ = 0
        Dim radius As Double
        radius = 3
        Dim dsCircle As DraftSight.Circle
        Set dsCircle = dsSketchMgr.InsertCircle(centerX, centerY, centerZ, radius)        

        'Draw an arc
        centerX = 10
        centerY = 2
        Dim arcRadius As Double
        arcRadius = 3
        Dim startAngle As Double
        startAngle = 0#
        Dim endAngle As Double
        endAngle = 3.14159265358979 / 3
        Dim dsArc As DraftSight.CircleArc
        Set dsArc = dsSketchMgr.InsertArc(centerX, centerY, centerZ, arcRadius, startAngle, endAngle)        

        'Add radius Dimension to circle
        Dim dimPosition(2) As Double
        dimPosition(0) = 7
        dimPosition(1) = 6
        dimPosition(2) = 0
        Dim dimTextOverride As String
        dimTextOverride = ""
        Dim dsRadialCircleDim As DraftSight.RadialDimension
        Set dsRadialCircleDim = dsSketchMgr.InsertRadialDimensionCircle(dsCircle, dimPosition, dimTextOverride)        

        'Print information about radius Dimension
        PrintRadialDimProperties dsRadialCircleDim        

        'Add radius Dimension to arc
        dimPosition(0) = 16
        dimPosition(1) = 3
        Dim dsRadialArcDim As DraftSight.RadialDimension
        Set dsRadialArcDim = dsSketchMgr.InsertRadialDimensionArc(dsArc, dimPosition, dimTextOverride)        

        'Print information about radius Dimension
        PrintRadialDimProperties dsRadialArcDim
    End Sub

    Sub DrawDiameterDimension(ByVal dsSketchMgr As DraftSight.SketchManager)
        'Draw a circle
        Dim centerX As Double
        centerX = 2
        Dim centerY As Double
        centerY = 2
        Dim centerZ As Double
        centerZ = 0
        Dim radius As Double
        radius = 3
        Dim dsCircle As DraftSight.Circle
        Set dsCircle = dsSketchMgr.InsertCircle(centerX, centerY, centerZ, radius)        

        'Draw an arc
        centerX = 10
        centerY = 2
        Dim arcRadius As Double
        arcRadius = 3
        Dim startAngle As Double
        startAngle = 0#
        Dim endAngle As Double
        endAngle = 3.14159265358979 / 3
        Dim dsArc As DraftSight.CircleArc
        Set dsArc = dsSketchMgr.InsertArc(centerX, centerY, centerZ, arcRadius, startAngle, endAngle)        

        'Add diameter Dimension to circle
        Dim dimPosition(2) As Double
        dimPosition(0) = 3
        dimPosition(1) = 8
        dimPosition(2) = 0        

        'No text override - empty string
        Dim dimTextOverride As String
        dimTextOverride = ""
        Dim dsDiameterCircleDim As DraftSight.DiameterDimension
        Set dsDiameterCircleDim = dsSketchMgr.InsertDiameterDimensionCircle(dsCircle, dimPosition, dimTextOverride)        

        'Print information about diameter Dimension
        PrintDiameterDimProperties dsDiameterCircleDim        

        'Add diameter Dimension to arc
        dimPosition(0) = 14
        dimPosition(1) = 6
        Dim dsDiameterArcDim As DraftSight.DiameterDimension
        Set dsDiameterArcDim = dsSketchMgr.InsertDiameterDimensionArc(dsArc, dimPosition, dimTextOverride)        

        'Print information about diameter Dimension
        PrintDiameterDimProperties dsDiameterArcDim
    End Sub

    Sub DrawRotatedDimension(ByVal dsSketchMgr As DraftSight.SketchManager)
        'Draw line
        Dim startX As Double
        startX = 10
        Dim startY As Double
        startY = -5
        Dim startZ As Double
        startZ = 0
        Dim endX As Double
        endX = 14
        Dim endY As Double
        endY = -5
        Dim endZ As Double
        endZ = 0
        Dim dsLine As DraftSight.Line
        Set dsLine = dsSketchMgr.InsertLine(startX, startY, startZ, endX, endY, endZ)        

        'Draw rotated Dimension
        Dim extLine1Point(2) As Double
        extLine1Point(0) = startX
        extLine1Point(1) = startY
        extLine1Point(2) = startZ
        Dim extLine2Point(2) As Double
        extLine2Point(0) = endX
        extLine2Point(1) = endY
        extLine2Point(2) = endZ
        Dim dimensionLinePosition(2) As Double
        dimensionLinePosition(0) = 16
        dimensionLinePosition(1) = -6
        dimensionLinePosition(2) = 0
        Dim dimTextOverride As String
        dimTextOverride = ""        

        'Angle 45 degrees (in radians)
        Dim rotationAngle As Double
        rotationAngle = 3.14159265358979 / 4
        Dim dsRotatedDim As DraftSight.RotatedDimension
        Set dsRotatedDim = dsSketchMgr.InsertRotatedDimension(extLine1Point, extLine2Point, dimensionLinePosition, dimTextOverride, rotationAngle)        

        'Print information about rotated Dimension
        PrintRotatedDimProperties dsRotatedDim
    End Sub

    Sub PrintArcLengthDimProperties(ByVal dsArcLengthDim As ArcLengthDimension)
        Debug.Print ("  Arc length Dimension parameters...")
        

        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Dim dsGeneralDim As DraftSight.GeneralDimension
        Set dsGeneralDim = dsArcLengthDim.GetGeneralDimension()
        PrintGeneralDimProperties dsGeneralDim        

        'Print specific parameters for arc length Dimension
        Debug.Print ("    ArcSymbolType = " & dsArcLengthDim.ArcSymbolType)
        Debug.Print ("    HasLeader = " & dsArcLengthDim.HasLeader)
        Debug.Print ("    IsPartial = " & dsArcLengthDim.IsPartial)
        Dim x As Double, y As Double, z As Double        

        'Get center point
        dsArcLengthDim.GetCenterPoint x, y, z
        Debug.Print ("    Center point (" & x & "," & y & "," & z & ")")        

        'Get arc point
        dsArcLengthDim.GetArcPoint x, y, z
        Debug.Print ("    Arc point (" & x & "," & y & "," & z & ")")        

        'Get extension line 1 point
        dsArcLengthDim.GetExtensionLine1Point x, y, z
        Debug.Print ("    Extension line 1 point (" & x & "," & y & "," & z & ")")        

        'Get extension line 2 point
        dsArcLengthDim.GetExtensionLine2Point x, y, z
        Debug.Print ("    Extension line 2 point (" & x & "," & y & "," & z & ")")
    End Sub

    Sub PrintRadialDimProperties(ByVal dsRadialDim As RadialDimension)
        Debug.Print ("  Radius Dimension parameters...")        

        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Dim dsGeneralDim As DraftSight.GeneralDimension
        Set dsGeneralDim = dsRadialDim.GetGeneralDimension()
        PrintGeneralDimProperties dsGeneralDim        

        'Print specific parameters for radius Dimension
        Dim x As Double, y As Double, z As Double        

        'Get center point
        dsRadialDim.GetCenterPoint x, y, z
        Debug.Print ("    Center point (" & x & "," & y & "," & z & ")")        

        'Get defining point
        dsRadialDim.GetDefiningPoint x, y, z
        Debug.Print ("    Defining point (" & x & "," & y & "," & z & ")")        

        'Print leader length value
        Debug.Print ("    Leader length = " & dsRadialDim.LeaderLength)
    End Sub

    Sub PrintDiameterDimProperties(ByVal dsDiameterDim As DiameterDimension)
        Debug.Print ("  Diameter Dimension parameters...")        

        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Dim dsGeneralDim As DraftSight.GeneralDimension
        Set dsGeneralDim = dsDiameterDim.GetGeneralDimension()
        PrintGeneralDimProperties dsGeneralDim        

        'Print specific parameters for diameter Dimension
        Dim x As Double, y As Double, z As Double

        'Get defining point
        dsDiameterDim.GetDefiningPoint x, y, z
        Debug.Print ("    Defining point (" & x & "," & y & "," & z & ")")        

        'Get far defining point
        dsDiameterDim.GetFarDefiningPoint x, y, z
        Debug.Print ("    Far defining point (" & x & "," & y & "," & z & ")")

        'Print leader length value
        Debug.Print ("    Leader length = " & dsDiameterDim.LeaderLength)
    End Sub

    Sub PrintJoggedDimProperties(ByVal dsJoggedDim As JoggedDimension)
        Debug.Print ("  Jogged Dimension parameters...")        

        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Dim dsGeneralDim As DraftSight.GeneralDimension
        Set dsGeneralDim = dsJoggedDim.GetGeneralDimension()
        PrintGeneralDimProperties dsGeneralDim        

        'Print specific parameters for jogged Dimension
        Debug.Print ("    Jog angle = " & dsJoggedDim.JogAngle)
        Dim x As Double, y As Double, z As Double        

        'Get center point
        dsJoggedDim.GetCenterPoint x, y, z
        Debug.Print ("    Center point (" & x & "," & y & "," & z & ")")

        'Get chord point
        dsJoggedDim.GetChordPoint x, y, z
        Debug.Print ("    Chord point (" & x & "," & y & "," & z & ")")

        'Get jog point
        dsJoggedDim.GetJogPoint x, y, z
        Debug.Print ("    Jog point (" & x & "," & y & "," & z & ")")

        'Get override center point
        dsJoggedDim.GetOverrideCenterPoint x, y, z
        Debug.Print ("    Override center point (" & x & "," & y & "," & z & ")")
    End Sub

    Sub PrintRotatedDimProperties(ByVal dsRotatedDim As RotatedDimension)
        Debug.Print ("  Rotated Dimension parameters...")        

        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Dim dsGeneralDim As DraftSight.GeneralDimension
        Set dsGeneralDim = dsRotatedDim.GetGeneralDimension()
        PrintGeneralDimProperties dsGeneralDim        

        'Print specific parameters for rotated Dimension
        Debug.Print ("    Rotation angle = " & dsRotatedDim.Rotation)
        Dim x As Double, y As Double, z As Double        

        'Get Dimension line point
        dsRotatedDim.GetDimensionLinePoint x, y, z
        Debug.Print ("    Dimension line point (" & x & "," & y & "," & z & ")")        

        'Get extension line 1 point
        dsRotatedDim.GetExtensionLine1Point x, y, z
        Debug.Print ("    Extension line 1 point (" & x & "," & y & "," & z & ")")        

        'Get extension line 2 point
        dsRotatedDim.GetExtensionLine2Point x, y, z
        Debug.Print ("    Extension line 2 point (" & x & "," & y & "," & z & ")")
    End Sub

    Sub PrintGeneralDimProperties(ByVal dsGeneralDim As GeneralDimension)
        'Get general Dimension object, which contains common Dimension properties,
        'and print them
        Debug.Print ("    Dimension style = " & dsGeneralDim.DimensionStyle)
        Debug.Print ("    Handle = " & dsGeneralDim.Handle)
        Debug.Print ("    Measurement = " & dsGeneralDim.Measurement)
        Debug.Print ("    Related = " & dsGeneralDim.Related)
        Debug.Print ("    Text override = " & dsGeneralDim.TextOverride)
        Debug.Print ("    TextRotation = " & dsGeneralDim.TextRotation)

        'Get text position
        Dim x As Double, y As Double
        dsGeneralDim.GetTextPosition x, y
        Debug.Print ("    Text position (" & x & "," & y & ")")
    End Sub