Change Dimension Example (VBA)

□ introduction

• Get Feature name and type with only dimension values ​​from model
• Get dimension name and value=
• Capture the image of the model. The location where the image is saved is "C:\temp".
• For detailed usage instructions, please refer to the video below.
  
  

solidworks02.xlsm

0.04MB

 

▷ Solidworks connection code

Public swApp As SldWorks.SldWorks
Public swModel As ModelDoc2
Public Sub SolidworksStart()
    On Error Resume Next
    '// Setting up SolidWorks application objects
    Set swApp = GetObject(, "SldWorks.Application")

    On Error GoTo 0
    If swApp Is Nothing Then
        MsgBox "Make sure SolidWorks is running.", vbCritical
        Exit Sub
    End If

    '// Get currently active document
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "There are no active SolidWorks documents.", vbCritical
        Exit Sub
    End If

End Sub

 

▷ Get dimension name and dimension value from Part

Option Explicit
Private swFeat As SldWorks.Feature
Private swDim As SldWorks.Dimension
Private WS As Worksheet
Private swDispDim As SldWorks.DisplayDimension
Dim rowIndex As Long
Dim dimIndex As Long
Sub ExportToExcel()
    On Error Resume Next
    Call SolidworksStart.SolidworksStart
    Set WS = ThisWorkbook.Worksheets("Model01")
    On Error GoTo 0
    '// Display model name
    WS.Cells(8, "C").value = swModel.GetTitle
    rowIndex = 10 '// The row where the data starts
    Set swFeat = swModel.FirstFeature
  
    Do While Not swFeat Is Nothing

        dimIndex = 0
        Set swDispDim = swFeat.GetFirstDisplayDimension()

        '// Show only if the feature has dimensions
        If Not swDispDim Is Nothing Then
            
            Do While Not swDispDim Is Nothing
                Set swDim = swDispDim.GetDimension()
                If Not swDim Is Nothing Then
                    WS.Cells(rowIndex, "A").value = rowIndex - 9
                    WS.Cells(rowIndex, "B").value = swFeat.Name
                    WS.Cells(rowIndex, "C").value = swFeat.GetTypeName2()
                    WS.Cells(rowIndex, "D").value = swFeat.GetID()
                    WS.Cells(rowIndex, "E").value = swDim.FullName
                    WS.Cells(rowIndex, "F").value = swDim.value
                    rowIndex = rowIndex + 1
                    dimIndex = dimIndex + 1
                End If
                Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
            Loop
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop

    MsgBox "SOLIDWORKS model data has been exported to Excel..", vbInformation
End Sub


'// Get the dimension values of a feature
Function GetFeatureDimensions(feat As SldWorks.Feature) As String
    Dim dimString As String
    dimString = ""

    '// Check the internal dimensions of the feature
    Set swDispDim = feat.GetFirstDisplayDimension()
    Do While Not swDispDim Is Nothing
        Set swDim = swDispDim.GetDimension()
        If Not swDim Is Nothing Then
            If dimString <> "" Then dimString = dimString & "; "
            dimString = dimString & swDim.FullName & "=" & swDim.value
        End If
        Set swDispDim = feat.GetNextDisplayDimension(swDispDim)
    Loop

    GetFeatureDimensions = dimString
End Function

 

▷ Create and save an image

Private Sub InsertModelImageIntoExcel()
    Dim swExport As Boolean
    Dim tempImagePath As String
    Dim img As Shape
    Dim targetCell As Range
    '// Insert image
    Set targetCell = WS.Range("E2:E8")
    
    '// Check if there is currently an active document
    If swModel Is Nothing Then
        MsgBox "There are no open models.", vbCritical
        Exit Sub
    End If

    ' Set temporary image storage path (BMP file)
    tempImagePath = "C:\Temp\ModelImage.jpg"
    
    ' Export image to JPG
   swExport = swModel.SaveAs4(tempImagePath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, 0, 0)
   
   
    ' Insert image
    Set img = ActiveSheet.Shapes.AddPicture(fileName:=tempImagePath, _
                                           LinkToFile:=False, _
                                           SaveWithDocument:=True, _
                                           Left:=targetCell.Left + 5, _
                                           Top:=targetCell.Top + 5, _
                                           Width:=targetCell.Width - 10, _
                                           Height:=targetCell.Height - 10)
                                                             
    ' Format the image (optional)
    With img
        .ShapeStyle = msoLineSolid
        .Line.Weight = 1
        .Fill.Visible = msoFalse ' Set image background transparent
    End With

    ' Delete temporary image files
    On Error Resume Next
    Kill tempImagePath
    On Error GoTo 0

End Sub

 

 

 

▷ Change model with modified dimension values 

Sub UpdateDimensions()
    
     Dim swDim As Dimension
     Dim lastRow As Range
     Dim j As Long
    
     Call SolidworksStart.SolidworksStart
     Set WS = ThisWorkbook.Worksheets("Model01")
     Set lastRow = WS.Range("E10", Cells(Rows.Count, "E").End(xlUp))
    
    For j = 0 To lastRow.Count - 1
    
        Set swDim = swModel.Parameter(WS.Cells(j + 10, "E"))
        swDim.SystemValue = WS.Cells(j + 10, "E").Offset(0, 1) / 1000
        
    Next j
    
    ' Model Update
    swModel.EditRebuild3
    MsgBox "Model changed successfully!", vbInformation
End Sub

 

 

 

by : korealionkk@gmail.com

---