Funktion InsertMoveCopyBody2

Hallo

Ich möchte mein Stück verschieben , das durch den Namen scale1 eines erstellten Punktes (point1) auf dem ursprünglichen Koordinatensystem dargestellt wird

Ich wähle die 3 Entitäten aus, aber wenn meine Funktion ausgeführt wird, passiert nichts

Kannst du mir helfen

Vielen Dank

Part.ClearSelection2 Wahr
boolstatus = Part.Extension.SelectByID2("Scale1", "BODYFEATURE", 0, 0, 0, False, 1, Nichts, 0)
boolstatus = Part.Extension.SelectByID2("Punkt1", "DATUMPUNKT", 0, 0, 0, Wahr, 2, Nichts, 0)
boolstatus = Part.Extension.SelectByID2("Point1@Origine", "EXTSKETCHPOINT", 0, 0, 0, True, 3, Nichts, 0)


MyFeature als Objekt dimmen

Festlegen von myFeature = Part.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)

Hallo, versuchen Sie das:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeatData As SldWorks.MoveCopyBodyFeatureData
Dim vFeat As Variant
Dim boolstatus As Boolean

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
boolstatus = swModel.Extension.SelectByID2("Echelle1", "BODYFEATURE", 0, 0, 0, False, 1, Nothing, 0)
Set vFeat = swModel.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)
Set swFeatData = vFeat.GetDefinition()

boolstatus = swModel.Extension.SelectByID2("Point1", "DATUMPOINT", 0, 0, 0, False, 1, Nothing, 0)
boolstatus = swModel.Extension.SelectByID2("Point1@Origine", "EXTSKETCHPOINT", 0, 0, 0, True, 1, Nothing, 0)
swFeatData.AddMate Nothing, swMateType_e.swMateCOINCIDENT, swMateAlign_e.swMateAlignCLOSEST, 0, 0, Empty
vFeat.ModifyDefinition swFeatData, swModel, Nothing
End Sub

 

Hallo

Der Körper ist an vorderster Front gut ausgewählt 

Makro stürzt in der nächsten Zeile ab

Festlegen von vFeat = swModel.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)

 

 

Hallo

Können Sie mir bei diesem Problem helfen?

Vielen Dank

 

 

Hallo

Hängen Sie Ihre Datei an, damit ich sie testen kann

1 „Gefällt mir“

Hallo

Hier ist mein Makro angehängt

 


macro4.swp

Kühl. Aber ich habe meinen Code bereits, also hilft er mir nicht wirklich:D Es ist Ihre SLDPRT-Datei, die ich brauche.

Die von Ihnen hinzugefügten Zeilen können jedoch Probleme verursachen, da die Variablen bereits unten definiert sind.

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

 

Im Anhang ist meine Datei


Teil1.SLDPRT

In der Tat funktioniert es nicht.
Aber es ist nicht verwunderlich, denn es funktioniert auch nicht, indem man die Funktion manuell erstellt.
Wir müssten Einschränkungen für die Entitäten (Fläche/Scheitelpunkt) des Volumenkörpers festlegen.
Die andere Lösung besteht darin, den Volumenkörper von den Koordinaten des Punktes zu verschieben:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim vFeat As Variant
Dim boolstatus As Boolean
Dim swFeat As SldWorks.Feature
Dim swRefPt As SldWorks.RefPoint
Dim swMathPt As SldWorks.MathPoint

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
boolstatus = swModel.Extension.SelectByID2("Point1", "DATUMPOINT", 0, 0, 0, False, 1, Nothing, 0)
Set swFeat = swModel.SelectionManager.GetSelectedObject6(1, -1)
Set swRefPt = swFeat.GetSpecificFeature2
Set swMathPt = swRefPt.GetRefPoint
boolstatus = swModel.Extension.SelectByID2("Boss.-Extru.1", "SOLIDBODY", 0, 0, 0, False, 1, Nothing, 0)
Set vFeat = swModel.FeatureManager.InsertMoveCopyBody2(swMathPt.ArrayData(0), swMathPt.ArrayData(1), swMathPt.ArrayData(2), 0, 0, 0, 0, 0, 0, 0, False, 1)
End Sub