Hide Table of Contents

Insert DXF/DWG File and Add Dimensions Example (VBA)

This example shows how to insert a DXF/DWG image on a preselected plane or face and then autodimension it.

'----------------------------------------------------------------------------
' Preconditions:
' 1. Open a part.
' 2. Replace path_name with the pathname of an existing DXF/DWG file.
' 3. Select a plane or face on which to insert the DXF/DWG image.
'
' Postconditions:
' 1. The DXF/DWG image is added as a sketch.
' 2. The sketch is autodimensioned.
' 3. The macro pauses.
' 4. Inspect the sketch dimensioning.
' 5. Press F5 to rebuild the model.
'---------------------------------------------------------------------------

Option Explicit

Const nTolerance                    As Double = 0.00000001
Dim swModelView                     As SldWorks.ModelView
Dim swSketchMgr                     As SldWorks.SketchManager
Dim nRetVal                         As Long

Sub main()

    Const sDwgFileName                  As String = "path_name"

    Dim swApp                           As SldWorks.SldWorks
    Dim swModel                         As SldWorks.ModelDoc2
    Dim swFeatMgr                       As SldWorks.FeatureManager
    Dim swFeat                          As SldWorks.Feature
    Dim swSketch                        As SldWorks.Sketch
    Dim swSelMgr                        As SldWorks.SelectionMgr
    Dim swSelData                       As SldWorks.SelectData
    Dim bRet                            As Boolean
    Dim importData                      As SldWorks.ImportDxfDwgData

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swModelView = swModel.ActiveView
    Set swFeatMgr = swModel.FeatureManager
    Set importData = swApp.GetImportFileData(sDwgFileName)
   

    'Unit
    importData.LengthUnit("") = SwConst.swLengthUnit_e.swMM
   

    'Position
    bRet = importData.SetPosition("", swDwgEntitiesCentered, 0, 0)
   

    'Sheet scale
    bRet = importData.SetSheetScale("", 1#, 2#)
   

    'Paper size
    bRet = importData.SetPaperSize("", SwConst.swDwgPaperSizes_e.swDwgPaperAsize, 0#, 0#)
   

    'Import method
    importData.ImportMethod("") = swImportDxfDwg_ImportMethod_e.swImportDxfDwg_ImportToExistingPart

    Set swFeat = swFeatMgr.InsertDwgOrDxfFile2(sDwgFileName, importData)
   

    Set swSketch = swFeat.GetSpecificFeature2
    Set swSelMgr = swModel.SelectionManager
    Set swSelData = swSelMgr.CreateSelectData

    nRetVal = AutoDimensionSketch(swApp, swModel, swSketch, swSelData)

    Stop
   

    ' Rebuild to update sketch
    swModel.EditRebuild3

End Sub

Function GetAllSketchLines(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch) As Variant

    Dim vSketchSegArr                   As Variant
    Dim vSketchSeg                      As Variant
    Dim swSketchSeg                     As SldWorks.SketchSegment
    Dim swSketchCurrLine                As SldWorks.SketchLine
    Dim swSketchLineArr()               As SldWorks.SketchLine
    ReDim swSketchLineArr(0)

    vSketchSegArr = swSketch.GetSketchSegments

    If Not IsEmpty(vSketchSegArr) Then
        For Each vSketchSeg In vSketchSegArr
            Set swSketchSeg = vSketchSeg
            If swSketchLINE = swSketchSeg.GetType Then
                Set swSketchCurrLine = swSketchSeg
                Set swSketchLineArr(UBound(swSketchLineArr)) = swSketchCurrLine
                ReDim Preserve swSketchLineArr(UBound(swSketchLineArr) + 1)
            End If
        Next
    End If

    If 0 = UBound(swSketchLineArr) Then
        ' No straight lines in this sketch
        GetAllSketchLines = Empty
        Exit Function
    End If

    ' Remove last, empty sketch line
    ReDim Preserve swSketchLineArr(UBound(swSketchLineArr) - 1)
    GetAllSketchLines = swSketchLineArr

End Function

Function GetSketchPoint(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSketchPt As SldWorks.SketchPoint) As Boolean

    Dim vSketchPtArr                    As Variant
    vSketchPtArr = swSketch.GetSketchPoints2
    If Not IsEmpty(vSketchPtArr) Then
        ' Use first point
        Set swSketchPt = vSketchPtArr(0)
        GetSketchPoint = True
        Exit Function
    End If
    GetSketchPoint = False

End Function

Function FindVerticalOrigin(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSketchSegVert As SldWorks.SketchSegment, swSketchPtVert As SldWorks.SketchPoint) As Boolean

    Dim vSketchLineArr                  As Variant
    Dim vSketchLine                     As Variant
    Dim swSketchCurrLine                As SldWorks.SketchLine
    Dim swStartPt                       As SldWorks.SketchPoint
    Dim swEndPt                         As SldWorks.SketchPoint

    ' Get first vertical line
    vSketchLineArr = GetAllSketchLines(swApp, swModel, swSketch)

    If Not IsEmpty(vSketchLineArr) Then
        For Each vSketchLine In vSketchLineArr
            Set swSketchCurrLine = vSketchLine
            Set swStartPt = swSketchCurrLine.GetStartPoint2
            Set swEndPt = swSketchCurrLine.GetEndPoint2

            If Abs(swStartPt.X - swEndPt.X) < nTolerance Then
                Set swSketchSegVert = swSketchCurrLine
                FindVerticalOrigin = True
                Exit Function
            End If
        Next
    End If

    ' Get first point
    FindVerticalOrigin = GetSketchPoint(swApp, swModel, swSketch, swSketchPtVert)

End Function

Function FindHorizontalOrigin(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSketchSegHoriz As SldWorks.SketchSegment, swSketchPtHoriz As SldWorks.SketchPoint) As Boolean

    Dim vSketchLineArr                  As Variant
    Dim vSketchLine                     As Variant
    Dim swSketchCurrLine                As SldWorks.SketchLine
    Dim swStartPt                       As SldWorks.SketchPoint
    Dim swEndPt                         As SldWorks.SketchPoint

    ' Get first horizontal line
    vSketchLineArr = GetAllSketchLines(swApp, swModel, swSketch)

    If Not IsEmpty(vSketchLineArr) Then
        For Each vSketchLine In vSketchLineArr
            Set swSketchCurrLine = vSketchLine
            Set swStartPt = swSketchCurrLine.GetStartPoint2
            Set swEndPt = swSketchCurrLine.GetEndPoint2

            If Abs(swStartPt.Y - swEndPt.Y) < nTolerance Then
                Set swSketchSegHoriz = swSketchCurrLine
                FindHorizontalOrigin = True
                Exit Function
            End If
        Next
    End If

    ' Get first point
    FindHorizontalOrigin = GetSketchPoint(swApp, swModel, swSketch, swSketchPtHoriz)

End Function

Function AutoDimensionSketch(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swSketch As SldWorks.Sketch, swSelData As SldWorks.SelectData) As Long

    Dim swFeat                          As SldWorks.Feature
    Dim swSketchSegHoriz                As SldWorks.SketchSegment
    Dim swSketchPtHoriz                 As SldWorks.SketchPoint
    Dim swSketchSegVert                 As SldWorks.SketchSegment
    Dim swSketchPtVert                  As SldWorks.SketchPoint
    Dim bRet                            As Boolean

    If False = FindHorizontalOrigin(swApp, swModel, swSketch, swSketchSegHoriz, swSketchPtHoriz) Then
        AutoDimensionSketch = swAutodimStatusDatumLineNotHorizontal
        Exit Function
    End If

    If False = FindVerticalOrigin(swApp, swModel, swSketch, swSketchSegVert, swSketchPtVert) Then
        AutoDimensionSketch = swAutodimStatusDatumLineNotVertical
        Exit Function
    End If

    Set swFeat = swSketch

    bRet = swFeat.Select2(False, 0)

    ' Editing sketch clears selections
    swModel.EditSketch

    ' Reselect sketch segments with correct marks for auto-dimensioning
    If Not swSketchSegVert Is Nothing Then
        ' Vertical line is for horizontal datum
        bRet = swSketchSegVert.Select4(True, swSelData)
    ElseIf Not swSketchPtHoriz Is Nothing Then
            bRet = swSketchPtHoriz.Select4(True, swSelData)
    ElseIf Not swSketchPtVert Is Nothing Then
            ' Use any sketch point for horizontal datum
            bRet = swSketchPtVert.Select4(True, swSelData)
    End If

    If Not swSketchSegHoriz Is Nothing Then
        ' Horizontal line is for vertical datum
        bRet = swSketchSegHoriz.Select4(True, swSelData)
    ElseIf Not swSketchPtVert Is Nothing Then
        bRet = swSketchPtVert.Select4(True, swSelData)
    ElseIf Not swSketchPtHoriz Is Nothing Then
            ' Use any sketch point for vertical datum
            bRet = swSketchPtHoriz.Select4(True, swSelData)
    End If

    ' No straight lines, probably contains circles
    ' so use sketch points for datums
    If IsEmpty(GetAllSketchLines(swApp, swModel, swSketch)) Then
        If Not swSketchPtHoriz Is Nothing Then
            bRet = swSketchPtHoriz.Select4(False, swSelData)
        ElseIf Not swSketchPtVert Is Nothing Then
            bRet = swSketchPtVert.Select4(False, swSelData)
        End If
    End If

    Set swSketchMgr = swModel.SketchManager
    nRetVal = swSketchMgr.FullyDefineSketch(True, True, swSketchFullyDefineRelationType_e.swSketchFullyDefineRelationType_Vertical Or swSketchFullyDefineRelationType_e.swSketchFullyDefineRelationType_Horizontal, True, 1, Nothing, 1, Nothing, 1, 1)
   

    ' Redraw so dimensions are displayed immediately
    Dim rect() As Double
    swModelView.GraphicsRedraw (rect)
  

End Function



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:   Insert DXF/DWG File and Add Dimensions 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) 2012 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.