This example shows how to create, activate, and apply a new DimensionStyle. This example also shows how to create arc length, jogged, rotated, radius, and diameter Dimensions for circles, arcs, and a line.
'------------------------------------------------------------- ' 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