Hide Table of Contents

Dimension Edge in Drawing Example (VBA)

This examples shows how to dimension an edge in a drawing view.

 

'----------------------------------------------

'

' Problem:

'       This example shows how to automatically add a

'       dimension to a straight edge in all drawing views

'       in which it appears. The edge geometry is transformed

'       to the space of each drawing view and, depending on

'       whether it is horizontal or vertical, an appropriate

'       style of dimension is added.

'

'       This example could form the basis for an application

'       to automatically dimension a model when it is added to

'       a drawing.

'

' Preconditions:

'       (1) Part or assembly is open.

'       (2) If an assembly, it is fully resolved.

'       (3) A straight edge is selected in the SOLIDWORKS graphics area.

'

' Postconditions:

'       (1) New drawing is created with three views.

'       (2) If possible, the previously selected edge

'          is dimensioned in all drawing views.

'

' NOTE:  The dimension is not created if

'        the edge cannot be converted in a drawing view.

'

'----------------------------------------------

Option Explicit

Public Const LINE_TYPE              As Integer = 3001

Public Const CIRCLE_TYPE            As Integer = 3002

Public Const ELLIPSE_TYPE           As Integer = 3003

Public Const INTERSECTION_TYPE      As Integer = 3004

Public Const BCURVE_TYPE            As Integer = 3005

Public Const SPCURVE_TYPE           As Integer = 3006

Public Const CONSTPARAM_TYPE        As Integer = 3008

Public Const TRIMMED_TYPE           As Integer = 3009

 

' Define two types

Type DoubleRec

    dValue As Double

End Type

Type Long2Rec

    iLower As Long

    iUpper As Long

End Type

 

' Extract two integer values out of a single double value,

' by assigning a DoubleRec to the double value and

' copying the value over an Long2Rec and

' extracting the integer values.

Function ExtractFields _

( _

    ByVal dValue As Double, _

    iLower As Long, _

    iUpper As Long _

)

    Dim dr                          As DoubleRec

    Dim i2r                         As Long2Rec

    ' Set the double value

    dr.dValue = dValue

    ' Copy the values

    LSet i2r = dr

    ' Extract the values

    iLower = i2r.iLower

    iUpper = i2r.iUpper

End Function

 

Sub main()

 

    Const sPathToTemplate           As String = "c:\Program Files\SOLIDWORKS\data\templates\drawing.drtdot"

    

    Const nTolerance                As Double = 0.00000001

    

    Const nXoffset                  As Double = 0.01

    Const nYoffset                  As Double = 0.01

    

    Dim swApp                       As SldWorks.SldWorks

    Dim swModel                     As SldWorks.ModelDoc2

    Dim swSelMgr                    As SldWorks.SelectionMgr

    Dim swEdge                      As SldWorks.Edge

    Dim swEnt                       As SldWorks.entity

    Dim swCurve                     As SldWorks.Curve

    Dim vCurveParam                 As Variant

    Dim nDummy                      As Long

    Dim nIdentity                   As Long

    Dim nTag                        As Long

    Dim nSense                      As Long

    

    Dim swMathUtil                  As SldWorks.MathUtility

    Dim nPtData(2)                  As Double

    Dim vPtData                     As Variant

    Dim swModelStartPt              As SldWorks.MathPoint

    Dim swModelEndPt                As SldWorks.MathPoint

    Dim swViewStartPt               As SldWorks.MathPoint

    Dim swViewEndPt                 As SldWorks.MathPoint

    

    Dim swDraw                      As SldWorks.DrawingDoc

    Dim swDrawModel                 As SldWorks.ModelDoc2

    Dim swView                      As SldWorks.view

    Dim swViewXform                 As SldWorks.MathTransform

    Dim vOutline                    As Variant

    Dim swDispDim                   As SldWorks.DisplayDimension

    

    Dim nXpos                       As Double

    Dim nYpos                       As Double

    Dim bRet                        As Boolean

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swEdge = swSelMgr.GetSelectedObject5(1)

    Set swCurve = swEdge.GetCurve

    Set swEnt = swEdge

    

    vCurveParam = swEdge.GetCurveParams2

    ExtractFields vCurveParam(8), nDummy, nIdentity

    ExtractFields vCurveParam(9), nDummy, nTag

    ExtractFields vCurveParam(10), nDummy, nSense

    

    Debug.Print "Start      = (" & vCurveParam(0) * 1000# & ", " & vCurveParam(1) * 1000# & ", " & vCurveParam(2) * 1000# & ") mm "

    Debug.Print "End        = (" & vCurveParam(3) * 1000# & ", " & vCurveParam(4) * 1000# & ", " & vCurveParam(5) * 1000# & ") mm "

    Debug.Print "Uparam     = [" & vCurveParam(6) & ", " & vCurveParam(7) & "]"

    Debug.Print "Identity   = " & nIdentity

    Debug.Print "Tag        = " & nTag

    Debug.Print "Sense      = " & nSense

    

    ' Derived quantity

    Debug.Print "Length     = " & swCurve.GetLength2(vCurveParam(6), vCurveParam(7)) * 1000# & " mm "

    Debug.Print ""

    

    ' Only makes sense for straight edges

    If LINE_TYPE <> nIdentity Then Exit Sub

    

    Set swMathUtil = swApp.GetMathUtility

    

    nPtData(0) = vCurveParam(0)

    nPtData(1) = vCurveParam(1)

    nPtData(2) = vCurveParam(2)

    vPtData = nPtData

    Set swModelStartPt = swMathUtil.CreatePoint(vPtData)

    

    nPtData(0) = vCurveParam(3)

    nPtData(1) = vCurveParam(4)

    nPtData(2) = vCurveParam(5)

    vPtData = nPtData

    Set swModelEndPt = swMathUtil.CreatePoint(vPtData)

    

    

    ' Start creating drawing of the model

    Set swDraw = swApp.NewDocument("C:\Program Files\SOLIDWORKS\data\templates\drawing.drwdot", swDwgPaperAsize, 0, 0)

    Set swDrawModel = swDraw

    

    bRet = swDraw.Create3rdAngleViews2(swModel.GetPathName)

    Debug.Assert bRet

    

    Set swView = swDraw.GetFirstView

    Set swView = swView.GetNextView

    Do While Not swView Is Nothing

        ' Select regardless

        bRet = swView.SelectEntity(swEnt, False)

        Debug.Assert bRet

        

        vOutline = swView.GetOutline

        

        Set swViewXform = swView.ModelToViewTransform

        Set swViewStartPt = swModelStartPt.MultiplyTransform(swViewXform)

        Set swViewEndPt = swModelEndPt.MultiplyTransform(swViewXform)

        

        Debug.Print "View       = " & swView.Name

        Debug.Print "Start      = (" & swViewStartPt.ArrayData(0) * 1000# & ", " & swViewStartPt.ArrayData(1) * 1000# & ", " & swViewStartPt.ArrayData(2) * 1000# & ") mm "

        Debug.Print "End        = (" & swViewEndPt.ArrayData(0) * 1000# & ", " & swViewEndPt.ArrayData(1) * 1000# & ", " & swViewEndPt.ArrayData(2) * 1000# & ") mm "

        Debug.Print ""

        

        If Abs(swViewStartPt.ArrayData(0) - swViewEndPt.ArrayData(0)) < nTolerance Then

            ' Must be vertical

            ' Place dimension midway up edge and to the right of view

            nXpos = vOutline(0) - nXoffset

            nYpos = Abs((swViewStartPt.ArrayData(1) + swViewEndPt.ArrayData(1)) / 2#)

            

            ' NULL if cannot convert edge in this view

            Set swDispDim = swDrawModel.AddVerticalDimension2(nXpos, nYpos, 0#)

        ElseIf Abs(swViewStartPt.ArrayData(1) - swViewEndPt.ArrayData(1)) < nTolerance Then

            ' Must be horizontal

            ' Place dimension midway across edge and above view

            nXpos = Abs((swViewStartPt.ArrayData(0) + swViewEndPt.ArrayData(0)) / 2#)

            nYpos = vOutline(3) + nYoffset

            

            ' NULL if cannot convert edge in this view

            Set swDispDim = swDrawModel.AddHorizontalDimension2(nXpos, nYpos, 0#)

        Else

            ' Neither horizontal or vertical

            ' Place dimension near middle of edge

            nXpos = Abs((swViewStartPt.ArrayData(0) + swViewEndPt.ArrayData(0)) / 2#) + nXoffset

            nYpos = Abs((swViewStartPt.ArrayData(1) + swViewEndPt.ArrayData(1)) / 2#) + nYoffset

    

            ' Depends on the orientation of the entity in the drawing view,

            ' thus, could be NULL

            '

            ' Create the dimension even if the entity is not

            ' visible in the drawing view

            Set swDispDim = swDrawModel.AddDimension2(nXpos, nYpos, 0#)

        End If

        

        Set swView = swView.GetNextView

    Loop

End Sub

'-------------------------------------------



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Dimension Edge in Drawing Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2016 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.