标题: 如何遍历零件→草图→尺寸. [打印本页] 作者: chq6 时间: 2011-8-11 13:24 标题: 如何遍历零件→草图→尺寸. Api论坛人气不够,在这里看是否能解决问题?
Sokidowrks API 二次开发的书中,给出的是遍历特征树的示例.
Set swFeat = swPart.FirstFeature
Do While Not swFeat Is Nothing
FeatTypeName = swFeat.GetTypeName
Debug.Print FeatTypeName
......
Loop
零件什么都没画时其结果是
DetailCabinet
CommentsFolder
DocsFolder
SurfaceBodyFolder
SolidBodyFolder
MaterialFolder
EnvFolder
RefPlane
RefPlane
RefPlane
OriginProfileFeature
----------------------
添加了两个蓝图后.增加了两项
ProfileFeature
ProfileFeature
----------------------------------------------
由此可以判断
Set swFeat = swPart.FirstFeature→如何改就能遍历草图的内容.
谢谢.作者: litaohong 时间: 2011-8-11 13:26
这是SW帮助文件中的一个草图示例 草图→Set swSketch = swModel.GetActiveSketch2
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSketch As SldWorks.Sketch
Dim swFeat As SldWorks.Feature
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Get the open sketch
Set swSketch = swModel.GetActiveSketch2
Set swFeat = swSketch
' Change the name of the open sketch to CircleSketch
swFeat.Name = "CircleSketch"作者: yudihui 时间: 2011-8-11 13:27
帮助文件又一例
Public Enum swLineTypes_e
swLF_VISIBLE = 0
swLF_HIDDEN = 1
swLF_SKETCH = 2
swLF_DETAIL = 3
swLF_SECTION = 4
swLF_DIMENSION = 5
swLF_CENTER = 6
swLF_HATCH = 7
swLF_TANGENT = 8
End Enum
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeat As SldWorks.Feature
Dim swSketch As SldWorks.Sketch
Dim NumArcs As Long
Dim vArcs As Variant
Dim i As Variant
Dim bRet As Boolean
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swFeat = swSelMgr.GetSelectedObject5(1)
Set swSketch = swFeat.GetSpecificFeature
NumArcs = swSketch.GetArcCount
Debug.Print "Feature = " & swFeat.GetTypeName
Debug.Print " NumArcs = " & NumArcs
Debug.Print ""
vArcs = swSketch.GetArcs2
If IsEmpty(vArcs) Then Exit Sub
Debug.Assert UBound(vArcs) + 1 = 16 * NumArcs
For i = 0 To NumArcs - 1
Debug.Print " Arc(" & i & ")"
Debug.Print " colour = " & vArcs(16 * i + 0)
Debug.Print " type = " & vArcs(16 * i + 1)
Debug.Print " font = " & vArcs(16 * i + 2)
Debug.Print " width = " & vArcs(16 * i + 3)
Debug.Print " layerID = " & vArcs(16 * i + 4)
Debug.Print " layer override = " & vArcs(16 * i + 5)
Debug.Print " start = (" & _
vArcs(16 * i + 6) * 1000# & ", " & _
vArcs(16 * i + 7) * 1000# & ", " & _
vArcs(16 * i + 8) * 1000# & ") mm"
Debug.Print " end = (" & _
vArcs(16 * i + 9) * 1000# & ", " & _
vArcs(16 * i + 10) * 1000# & ", " & _
vArcs(16 * i + 11) * 1000# & ") mm"
Debug.Print " ctr = (" & _
vArcs(16 * i + 12) * 1000# & ", " & _
vArcs(16 * i + 13) * 1000# & ", " & _
vArcs(16 * i + 14) * 1000# & ") mm"
Debug.Print " RotDir = " & _
vArcs(16 * i + 15)
Next i
End Sub
-------------------------
Dim swApp As Object
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Sub main()
Set swApp = Application.SldWorks
Dim SwSketch As SldWorks.Sketch
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
'boolstatus = Part.Extension.SelectByID2("草图2", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
'boolstatus = Part.Extension.SelectByID2("草图3", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Set swFeat = SelMgr.GetSelectedObject5(1)
Set SwSketch = swFeat.GetSpecificFeature
'NumArcs = SwSketch.GetArcCount
With SwSketch
'nn = .GetArcCount
nn = .GetLineCount
nn = .GetUserPointsCount
Debug.Print "Feature = " & swFeat.GetTypeName
vArcs = SwSketch.GetUserPoints2
End With
End Sub
强势围观
直接秒杀我等普通用户，你是何居心啊。。