1 Reply Latest reply on Sep 28, 2013 11:19 AM by Yong Ning

    how to autodimension all sketches in Sheet metal

    Yong Ning

      0.jpg

       

      Hope, with API, drawing dimension.

       

       

      Use API help example → don't drawing dimension.

       

      Autodimension All Sketches Example (VB)

      This example shows how to autodimension all sketches in a part.

       

      2.jpg

       

      3.jpg

        • Re: how to autodimension all sketches in Sheet metal
          Yong Ning

          API help

          Autodimension All Sketches Example (VB)

          This example shows how to autodimension all sketches in a part.

           

          1.jpg

           

          the code is

           

          '--------------------------------------
          '
          ' Preconditions:
          '       (1) Part is open.
          '       (2) Part contains at least one sketch.
          '       (3) Sketch contains some sketch segments or geometry.
          '
          ' Postconditions: If successful, then all sketches have dimensions added to them.
          '
          ' Notes: Return code from Sketch::AutoDimension2 is output to the
          '        debug window. Examine this window if the call fails.
          '
          '-------------------------------------
          Option Explicit
          Public Enum swConstrainedStatus_e
              swUnknownConstraint = 1
              swUnderConstrained = 2
              swFullyConstrained = 3
              swOverConstrained = 4
              swNoSolution = 5
              swInvalidSolution = 6
              swAutosolveOff = 7
          End Enum
          Public Enum swSketchSegments_e
              swSketchLINE = 0
              swSketchARC = 1
              swSketchELLIPSE = 2
              swSketchSPLINE = 3
              swSketchTEXT = 4
              swSketchPARABOLA = 5
          End Enum
          Public Enum swAutodimEntities_e
              swAutodimEntitiesAll = 1
              swAutodimEntitiesSelected = 2
          End Enum
          Public Enum swAutodimMark_e
              swAutodimMarkEntities = &H1
              swAutodimMarkHorizontalDatum = &H2
              swAutodimMarkVerticalDatum = &H4
          End Enum
          Public Enum swAutodimScheme_e
              swAutodimSchemeBaseline = 1
              swAutodimSchemeOrdinate = 2
              swAutodimSchemeChain = 3
              swAutodimSchemeCenterline = 4
          End Enum
          Public Enum swAutodimHorizontalPlacement_e
              swAutodimHorizontalPlacementBelow = -1
              swAutodimHorizontalPlacementAbove = 1
          End Enum
          Public Enum swAutodimVerticalPlacement_e
              swAutodimVerticalPlacementLeft = -1
              swAutodimVerticalPlacementRight = 1
          End Enum
          Public Enum swAutodimStatus_e
              swAutodimStatusSuccess = 0
              swAutodimStatusBadOptionValue = 1
              swAutodimStatusNoActiveDoc = 2
              swAutodimStatusDocTypeNotSupported = 3
              swAutodimStatusNoActiveSketch = 4
              swAutodimStatus3DSketchNotSupported = 5
              swAutodimStatusSketchIsEmpty = 6
              swAutodimStatusSketchIsOverDefined = 7
              swAutodimStatusNoEntities = 8
              swAutodimStatusEntitiesNotValid = 9
              swAutodimStatusCenterlineNotAllowed = 10
              swAutodimStatusDatumNotSupplied = 11
              swAutodimStatusDatumNotUnique = 12
              swAutodimStatusDatumNotValidType = 13
              swAutodimStatusDatumLineNotCenterline = 14
              swAutodimStatusDatumLineNotVertical = 15
              swAutodimStatusDatumLineNotHorizontal = 16
              swAutodimStatusAlgorithmFailed = 17
          End Enum
          Public Enum swRebuildOptions_e
              swRebuildAll = &H1
              swForceRebuildAll = &H2
              swUpdateMates = &H4
              swCurrentSheetDisp = &H8
              swUpdateDirtyOnly = &H10
          End Enum
          Const swTnProfileFeature        As String = "ProfileFeature"
          Const nTolerance                As Double = 0.00000001
          Sub FindAllUnderConstrainedSketches _
          ( _
              swApp As SldWorks.SldWorks, _
              swModel As SldWorks.ModelDoc2, _
              sSketchNameArr() As String _
          )
              Dim swPart                          As SldWorks.PartDoc
              Dim swFeat                          As SldWorks.Feature
              Dim swSketch                        As SldWorks.Sketch
              Dim bRet                            As Boolean
             
              Set swPart = swModel
              Set swFeat = swPart.FirstFeature
             
              Do While Not swFeat Is Nothing
                  If swTnProfileFeature = swFeat.GetTypeName Then
                      Set swSketch = swFeat.GetSpecificFeature2
                     
                      If swUnderConstrained = swSketch.GetConstrainedStatus Then
                          sSketchNameArr(UBound(sSketchNameArr)) = swFeat.Name
                     
                          ReDim Preserve sSketchNameArr(UBound(sSketchNameArr) + 1)
                      End If
                  End If
                 
                  Set swFeat = swFeat.GetNextFeature
              Loop
             
              ' Remove last empty sketch name
              ReDim Preserve sSketchNameArr(UBound(sSketchNameArr) - 1)
          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.GetSketchPoints
              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
             
              ' Try to 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
             
              ' Try to get the 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
             
              ' Try to 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
             
              ' Try to get the first point
              FindHorizontalOrigin = GetSketchPoint(swApp, swModel, swSketch, swSketchPtHoriz)
          End Function
          Function AutoDimensionSketch _
          ( _
              swApp As SldWorks.SldWorks, _
              swModel As SldWorks.ModelDoc2, _
              swSketch As SldWorks.Sketch _
          ) 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)
              Debug.Assert bRet
             
              ' Editing sketch clears selections
              swModel.EditSketch
             
              ' Reselect sketch segments for autodimensioning
              If Not swSketchSegVert Is Nothing Then
                  ' Vertical line is for horizontal datum
                  bRet = swSketchSegVert.Select4(True, Nothing)
              ElseIf Not swSketchPtHoriz Is Nothing Then
                       bRet = swSketchPtHoriz.Select4(True, Nothing)
              ElseIf Not swSketchPtVert Is Nothing Then
                      ' Use any sketch point for horizontal datum
                       bRet = swSketchPtVert.Select4(True, Nothing)
                     
              End If
              Debug.Assert bRet
             
              If Not swSketchSegHoriz Is Nothing Then
                  ' Horizontal line is for vertical datum
                  bRet = swSketchSegHoriz.Select4(True, Nothing)
              ElseIf Not swSketchPtVert Is Nothing Then
                  bRet = swSketchPtVert.Select4(True, Nothing)
              ElseIf Not swSketchPtHoriz Is Nothing Then
                      ' Use any sketch point for vertical datum
                      bRet = swSketchPtHoriz.Select4(True, Nothing)
              End If
              Debug.Assert bRet
             
              ' 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, Nothing)
                  ElseIf Not swSketchPtVert Is Nothing Then
                      bRet = swSketchPtVert.Select4(False, Nothing)
                  End If
              End If
              Debug.Assert bRet
             
              AutoDimensionSketch = swSketch.AutoDimension2( _
                                      swAutodimEntitiesAll, _
                                      swAutodimSchemeBaseline, _
                                      swAutodimHorizontalPlacementBelow, _
                                      swAutodimSchemeBaseline, _
                                      swAutodimVerticalPlacementLeft)
             
              ' Redraw so dimensions are displayed immediately
              swModel.GraphicsRedraw2
             
              ' Exit sketch edit
              ' Leave rebuild to later
              swModel.InsertSketch2 False
          End Function
          Sub main()
              Dim swApp                           As SldWorks.SldWorks
              Dim swModel                         As SldWorks.ModelDoc2
              Dim swPart                          As SldWorks.PartDoc
              Dim sSketchNameArr()                As String
              Dim sSketchName                     As Variant
              Dim swFeat                          As SldWorks.Feature
              Dim swSketch                        As SldWorks.Sketch
              Dim nRetVal                         As Long
              Dim i                               As Long
              Dim bRet                            As Boolean
             
              Set swApp = CreateObject("SldWorks.Application")
              Set swModel = swApp.ActiveDoc
              Set swPart = swModel
             
              Debug.Print "File = " & swModel.GetPathName
             
              ReDim sSketchNameArr(0)
             
              FindAllUnderConstrainedSketches swApp, swModel, sSketchNameArr
             
              For Each sSketchName In sSketchNameArr
                  Set swFeat = swPart.FeatureByName(sSketchName)
                  Set swSketch = swFeat.GetSpecificFeature
                 
                  nRetVal = AutoDimensionSketch(swApp, swModel, swSketch)
                 
                  Debug.Print "  " & sSketchName & " = " & nRetVal
              Next
             
              ' Rebuild after modifying sketches
              bRet = swModel.EditRebuild3
              Debug.Assert bRet
          End Sub

          ************************

          'Autodimension a Sketch Example (VB)

          'This example shows how to autodimension a sketch.

           

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

          ' Preconditions:

          '       (1) Part or assembly is open.

          '       (2) Sketch is being edited.

          '       (3) Sketch contains some sketch segments or geometry.

          '       (4) At least two sketch entities are selected.

          '       (5) First selected sketch entity is used for horizontal datum.

          '       (6) Second selected sketch entity is used for vertical datum.

          '

          ' Postconditions: If successful, then dimensions are added to sketch.

          '

          ' NOTES: Return code from Sketch::AutoDimension2 is output to

          ' debug window and you should examine the code in the case of failure.

          '

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

           

          Sub main()

           

              Dim swApp                           As SldWorks.SldWorks

              Dim swModel                         As SldWorks.ModelDoc2

              Dim swSelMgr                        As SldWorks.SelectionMgr

              Dim swSketch                        As SldWorks.Sketch

              Dim swSketchSegHoriz                As SldWorks.SketchSegment

              Dim swSketchSegVert                 As SldWorks.SketchSegment

              Dim nRetVal                         As Long

              Dim i                               As Long

              Dim bRet                            As Boolean

             

              Set swApp = CreateObject("SldWorks.Application")

              Set swModel = swApp.ActiveDoc

              Set swSketch = swModel.GetActiveSketch2

              Set swSelMgr = swModel.SelectionManager

             

              Debug.Print

              Set swSketchSegHoriz = swSelMgr.GetSelectedObject5(1)

             

              Set swSketchSegVert = swSelMgr.GetSelectedObject5(2)

             

              swModel.ClearSelection2 True

             

              ' Reselect sketch segments with correct marks

              ' for auto-dimensioning

              bRet = swSketchSegHoriz.Select3(True, swAutodimMarkHorizontalDatum, Nothing)

              bRet = swSketchSegVert.Select3(True, swAutodimMarkVerticalDatum, Nothing)

             

              nRetVal = swSketch.AutoDimension2( _

                              swAutodimEntitiesAll, _

                              swAutodimSchemeBaseline, _

                              swAutodimHorizontalPlacementBelow, _

                              swAutodimSchemeBaseline, _

                              swAutodimVerticalPlacementLeft)

              Debug.Print "  AutoDim = " & nRetVal

             

              ' Redraw so dimensions are displayed immediately

              swModel.GraphicsRedraw2

          End Sub