|
1,写一个宏.
2,把草图名称改为"草图n".
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 mySelectData As SldWorks.SelectData
Dim skContour As SketchContour
Dim vEdges As Variant, myEdge As SldWorks.Edge
Dim NumArcs, uuu As Long
Dim vArcs As Variant
Dim vSkContours As Variant
Dim vSkSeg As Variant
Dim i As Integer
Dim boolstatus As Boolean
Dim swSkArc As SldWorks.SketchArc
Dim swCurve As SldWorks.Curve
Dim skPoint As Object
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set mySelectData = swSelMgr.CreateSelectData
Set swFeat = swPart.FeatureByName("草图n")
Set swSketch = swFeat.GetSpecificFeature
swModel.Extension.SelectByID2 "草图n", "SKETCH", 0, 0, 0, False, 0, Nothing, 0
swModel.EditSketch
If Not swSketch Is Nothing Then
NumArcs = swSketch.GetArcCount
vSkContours = swSketch.GetSketchContours()
For i = 0 To UBound(vSkContours)
vArcs = swSketch.GetArcs2
If IsEmpty(vArcs) Then Exit Sub
Set skContour = vSkContours(i)
If Not skContour Is Nothing Then
If skContour.IsClosed = 1 Then
uuu = skContour.GetEdgesCount
If uuu = 1 Then
vEdges = skContour.GetEdges
Set myEdge = vEdges(0)
Set swCurve = myEdge.GetCurve
vSkSeg = swCurve.CircleParams
boolstatus = skContour.Select2(False, mySelectData)
swModel.EditDelete
Set skPoint = swModel.SketchManager.CreatePoint(vSkSeg(0), vSkSeg(1), 0)
End If
End If
End If
Next i
swModel.SketchManager.InsertSketch True
End If
End Sub |
|