SolidWorks專門論壇 SolidWorks forum

 找回密碼
 註冊
查看: 302|回復: 0

另用巨集按鈕將3個零件圖面匯入至組合圖面中

[複製鏈接]
發表於 2023/12/11 14:36:47 | 顯示全部樓層 |閱讀模式
請問各位大大,
我想使用巨集按鈕,該按鈕會辨識下拉選單的名稱,並當對應的零件圖面匯入至一個組合圖面中
但都會遇到錯誤,物件不支援此屬性或方法的錯誤
以下是該按鈕的程式
想問看看是否有大大可以幫忙解答

Private Sub CommandButton50_Click()
    ' 初始化 SolidWorks 應用程式
    Dim swApp As Object
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    On Error GoTo 0
   
    ' 檢查 SolidWorks 是否已經開啟
    If swApp Is Nothing Then
        Set swApp = CreateObject("SldWorks.Application")
        If swApp Is Nothing Then
            MsgBox "無法啟動 SolidWorks。"
            Exit Sub
        End If
        swApp.Visible = True
    End If
   
    ' 檢查 SolidWorks 是否已經打開模型
    If Not swApp.Visible Then
        MsgBox "請先打開一個模型。"
        Exit Sub
    End If
   
    ' 零件檔案的路徑
    Dim partFilePath1 As String
    Dim partFilePath2 As String
   
    ' 根據 ComboBox 的選擇,指定零件檔案的路徑
    Select Case ComboBox1.Value
        Case "56/56"
            partFilePath1 = "D:\tool\HT5656.SLDPRT"
        Case "56/65"
            partFilePath1 = "D:\tool\HT5665.SLDPRT"
        Case "65/65"
            partFilePath1 = "D:\tool\HT6565.SLDPRT"
        Case Else
            MsgBox "請指定一種規格"
            Exit Sub
    End Select
   
    ' 根據 ComboBox2 的選擇,指定另一個零件檔案的路徑
    Select Case ComboBox2.Value
        Case "GK-225D"
            partFilePath2 = "D:\tool\GK-225D.SLDPRT"
        Case "CH-305-EM"
            partFilePath2 = "D:\tool\CH-305-EM.SLDPRT"
        Case Else
            MsgBox "請指定一種規格"
            Exit Sub
    End Select
   
    ' 確保ActiveDoc是組合文件
    If Not swApp.ActiveDoc.GetType = swDocASSEMBLY Then
        MsgBox "請打開一個組合文件。"
        Exit Sub
    End If
   
    ' 獲取組合文件
    Dim swAssemblyDoc As Object
    Set swAssemblyDoc = swApp.ActiveDoc
   
    ' 插入零件到組合
    Dim vComponentArr1 As Variant
    vComponentArr1 = swAssemblyDoc.MakeSketchBlock2(partFilePath1, 0, 0, 0, False)
   
    ' 插入另一個零件到組合
    Dim vComponentArr2 As Variant
    vComponentArr2 = swAssemblyDoc.MakeSketchBlock2(partFilePath2, 0, 0, 0, False)
   
    ' 刷新顯示
    MsgBox "正在刷新..."
    MsgBox "完成!"
End Sub
您需要登錄後才可以回帖 登錄 | 註冊

本版積分規則

論壇統計|手機版上論壇|論壇來自幾何科技 論壇架構版次 20231119

GMT+8, 2024/2/27 12:40 , Processed in 0.241538 second(s), 21 queries .

Powered by Discuz! X3.4 Licensed

© 2001-2023 Discuz! Team.

快速回復 返回頂部 返回列表