Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part.GetType 2 Then Exit Sub
If TypeName(Part.GetActiveSketch) "Nothing" Then Exit Sub
Set SelMgr = Part.SelectionManager
Set Found = SelMgr.GetSelectedObject5(1)
Set ent = SelMgr.GetSelectedObject6(1, -1)
point = SelMgr.GetSelectionPoint2(1, -1)
If IsEmpty(point) Then Exit Sub
Part.SketchManager.Insert3DSketch True
Dim SkPoint As Object
Part.SetAddToDB (True)
Set SkPoint = Part.SketchManager.CreatePoint(point(0), point(1), point(2))
Part.SketchManager.InsertSketch True
Part.ClearSelection2 True
SkPoint.Select4 False, SelMgr
ent.Select2 True, 0
Dim longstatus As Long
Part.AddMate2 0, 0, False, 0, 0, 0, 1, 1, 0, 0, 0, longstatus
Part.ClearSelection2 True
End Sub
求教：点一下“复制代码”就能把上面的代码复制的原理
路过，来看看，支持楼主{:3_59:}