如何获得当前打开的工程图的对应的零件属性

天涯吹雪/go · 发表于 2015-12-5 13:16:25

如何获得当前打开的工程图的对应的零件属性。
我想获得当前打开的工程图的对应的零件的属性。比如获得工程图的零件属性中的“名称”，“代号”等等

sea001 · 发表于 2015-12-5 13:22:35

'（1）基本思路：获取当前图纸的某一视图的模型，然后打开这个模型，获取他的属性
'（2）获取当前图纸的某一视图的思路：1，人工选择；2，判断图纸中就一个模型，选择一个视图
'（3）打开模型的思路：先判断格式（不然swViewModel=nothing，获取的 swModelCustPropMgr 会报错），然后在后台打开，不会显示
'（4）获取属性：有很多方式，具体看你有什么方式，下面的是用属性的名称。
' 希望有所帮助！
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim vView As Variant
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelCustPropMgr As SldWorks.CustomPropertyManager
Dim modelmaneCollection As New Collection
Dim swViewModel As SldWorks.ModelDoc2
Dim vCustPropNames As Variant
Dim swSheet As SldWorks.Sheet
Dim i As Integer
Dim strValOut As String
Dim strExtension As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
'判断当前SWapp是否打开模型
If swModel Is Nothing Then
MsgBox "打开一个工程图，再运行这个宏……", vbOKOnly + vbExclamation + vbMsgBoxSetForeground, "Warning"
Exit Sub
End If
'判断当前模型是否是"SLDDRW"格式
strExtension = Right(UCase(swModel.GetPathName), 6)
If strExtension <> "SLDDRW" Then
MsgBox "打开一个工程图，再运行这个宏……", vbOKOnly + vbExclamation + vbMsgBoxSetForeground, "Warning"
Exit Sub
End If
'判断当前图纸被选中的实体是否为 View
Set swSelMgr = swModel.SelectionManager
If swSelMgr.GetSelectedObjectType3(1, -1) = swSelDRAWINGVIEWS Then
Set swView = swSelMgr.GetSelectedObject6(1, -1)
strExtension = Right(UCase(swView.GetReferencedModelName), 6)
If strExtension = "SLDPRT" Then
Set swViewModel = swApp.OpenDoc6(swView.GetReferencedModelName, swDocPART, _
swOpenDocOptions_Silent, Empty, Empty, Empty)
ElseIf strExtension = "SLDASM" Then
Set swViewModel = swApp.OpenDoc6(swView.GetReferencedModelName, swDocPART, _
swOpenDocOptions_Silent, Empty, Empty, Empty)
End If
Set swModelCustPropMgr = swViewModel.Extension.CustomPropertyManager(Empty)
vCustPropNames = swModelCustPropMgr.GetNames
For i = 0 To UBound(vCustPropNames)
strValOut = vCustPropNames(i) '得到打开模型的属性，然后打印
Debug.Print strValOut
Next
Else '没有选择或者选择的不是View
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
vView = swSheet.GetViews
Dim m As Integer
For m = 0 To UBound(vView)
Set swView = vView(m)
modelmaneCollection.Add swView.GetReferencedModelName '获得当前图纸所有View的模型名称
Next
For m = 1 To modelmaneCollection.Count - 1
If modelmaneCollection(m) <> modelmaneCollection(m + 1) Then '判断所有View的模型是否形同
MsgBox "图纸中有多个模型，请选择一个视图，然后运行这个宏……", _
vbOKCancel + vbMsgBoxSetForeground + vbInformation, "Solidwoks"
Exit Sub '有不同直接退出
End If
Next
Set swView = vView(0) '所有模型相同，打开其中一个
strExtension = Right(UCase(swView.GetReferencedModelName), 6)
If strExtension = "SLDPRT" Then
Set swViewModel = swApp.OpenDoc6(swView.GetReferencedModelName, swDocPART, _
swOpenDocOptions_Silent, Empty, Empty, Empty)
ElseIf strExtension = "SLDASM" Then
Set swViewModel = swApp.OpenDoc6(swView.GetReferencedModelName, swDocPART, _
swOpenDocOptions_Silent, Empty, Empty, Empty)
End If
Set swModelCustPropMgr = swViewModel.Extension.CustomPropertyManager(Empty)
vCustPropNames = swModelCustPropMgr.GetNames
For i = 0 To UBound(vCustPropNames)
strValOut = vCustPropNames(i) '得到打开模型的属性，然后打印
Debug.Print strValOut
Next
End If
End Sub

复制代码

乐飞豹夺 · 发表于 2015-12-5 13:33:15

因为你工程图本身就连接了零件的属性，所以直接遍历工程图文本，就可以获取到了啊

ltzz12345 · 发表于 2015-12-5 13:35:53

恩，是的。赞同。而且还简单。

风雨阳光 · 发表于 2024-4-26 13:27:46

经典案例图书

感谢楼主分享，很不错！

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