装配体或零件与同名工程图关联，运行故障，求解大神

doszmw · 发表于 2023-12-27 13:11:00

装配体或零件关联并打开同名工程图，chatgpt写的，但是报错，希望大神解决一下
Sub LinkDrawingToModel()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawing As SldWorks.DrawingDoc
Dim swModelName As String
Dim swDrawingName As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' 检查当前文档是否为零件或装配体
If Not swModel.GetType = swDocumentTypes_e.swDocPART And Not swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
      MsgBox "请先打开一个零件或装配体"
      Exit Sub
End If

' 获取模型的文件名
swModelName = swModel.GetPathName

' 检查是否已保存模型
If swModelName = "" Then
      MsgBox "请先保存模型"
      Exit Sub
End If

   检查是否已打开同名的工程图
swDrawingName = Replace(swModelName, ".sldprt", ".slddrw")
swDrawingName = Replace(swDrawingName, ".sldasm", ".slddrw")

If Not swApp.IsOpened(swDrawingName) Then
      MsgBox "请先打开同名的工程图"
   Exit Sub
End If

   关联工程图与模型
Set swDrawing = swApp.ActivateDoc3(swDrawingName, False, swRebuildOnActivation_e.swDontRebuildActiveDoc, Empty)
swDrawing.ReloadModel swModelName

MsgBox "工程图已成功关联到模型"
End Sub

沉默的人 · 发表于 2023-12-27 13:30:58

顶一下，坐等高手！

doszmw · 发表于 2023-12-27 16:34:19

这个也是有问题
Sub AssociateDrawingWithPart()
      Dim swApp As SldWorks.SldWorks
      Dim swModel As SldWorks.ModelDoc2
      Dim swDrawing As SldWorks.DrawingDoc
      Dim swModelView As SldWorks.ModelView
      Dim bIsFound As Boolean
      Dim strDrawingName As String
      Dim strPartName As String
      Dim strDrawingPath As String
      Dim strPartPath As String
      Dim strAssociateName As String

      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc
      Set swDrawing = swApp.GetDrawing2(swModel.FileName)
      Set swModelView = swDrawing.GetModelView2(swModel.FileName)

      strDrawingName = Left(swDrawing.FileName, Len(swDrawing.FileName) - 5) ' Remove extension '.slddrw'
      strPartName = Left(swModel.FileName, Len(swModel.FileName) - 5) ' Remove extension '.sldprt'
      strDrawingPath = swDrawing.GetPathName
      strPartPath = swModel.GetPathName
      strAssociateName = "Assembly" ' This can be any name you want to use to represent the assembly in the drawing view.

      ' Check if drawing and part have the same name (ignoring extension)
      If strDrawingName = strPartName Then
         bIsFound = True
         swModelView.ClearAllAssociativeRelations
         swModelView.AddAssociativeRelation2 swModel, , , , , , , , , strAssociateName, , , , , , , , True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, False
      End If
End Sub

doszmw · 发表于 2023-12-27 16:35:09

Sub AssociateDrawingWithPart()
      Dim swApp As SldWorks.SldWorks
      Dim swModel As SldWorks.ModelDoc2
      Dim swDrawing As SldWorks.DrawingDoc
      Dim swModelView As SldWorks.ModelView
      Dim bIsFound As Boolean
      Dim strDrawingName As String
      Dim strPartName As String
      Dim strDrawingPath As String
      Dim strPartPath As String
      Dim strAssociateName As String

      Set swApp = Application.SldWorks
      Set swModel = swApp.ActiveDoc
      Set swDrawing = swApp.GetDrawing2(swModel.FileName)
      Set swModelView = swDrawing.GetModelView2(swModel.FileName)

      strDrawingName = Left(swDrawing.FileName, Len(swDrawing.FileName) - 5) ' Remove extension '.slddrw'
      strPartName = Left(swModel.FileName, Len(swModel.FileName) - 5) ' Remove extension '.sldprt'
      strDrawingPath = swDrawing.GetPathName
      strPartPath = swModel.GetPathName
      strAssociateName = "Assembly" ' This can be any name you want to use to represent the assembly in the drawing view.

      ' Check if drawing and part have the same name (ignoring extension)
      If strDrawingName = strPartName Then
         bIsFound = True
         swModelView.ClearAllAssociativeRelations
         swModelView.AddAssociativeRelation2 swModel, , , , , , , , , strAssociateName, , , , , , , , True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, False
      End If
End Sub

xuhuaying · 发表于 2023-12-28 12:25:21

经典案例图书

SolidWorks机械工程师网，顶一下。

工程Jay_chen · 发表于 2023-12-28 17:01:55

顶一下，坐等高手！

lxr8833661 · 发表于 2023-12-28 20:40:25

经典案例图书

工程Jay_chen 发表于 2023-12-28 17:01
顶一下，坐等高手！

对圣诞星这首歌怎么看？

13650987636 · 发表于 2023-12-29 07:28:46

SolidWorks机械工程师网，顶一下。

		自动登录	找回密码
密码			立即注册

装配体或零件与同名工程图关联，运行故障，求解大神

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献