Functie InsertMoveCopyBody2

Hallo

Ik ben op zoek naar het verplaatsen van mijn stuk, vertegenwoordigd door de naam schaal1 van een gemaakt punt (punt1) op het originele coördinatensysteem

Ik selecteer de 3 entiteiten, maar wanneer mijn functie wordt uitgevoerd, gebeurt er niets

Kun je me helpen

Hartelijk dank

Deel.ClearSelection2 Waar
boolstatus = Part.Extension.SelectByID2("Schaal1", "BODYFEATURE", 0, 0, 0, Onwaar, 1, Niets, 0)
boolstatus = Part.Extension.SelectByID2("Punt1", "DATUMPUNT", 0, 0, 0, Waar, 2, Niets, 0)
boolstatus = Part.Extension.SelectByID2("Point1@Origine", "EXTSKETCHPOINT", 0, 0, 0, True, 3, Niets, 0)


Dim myFeature als object

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

Hallo, Probeer het volgende:

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

Het lichaam is goed geselecteerd in de frontlinie

Macro crasht op de volgende regel

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

 

 

Hallo

Kunt u mij helpen met dit probleem?

Bedankt

 

 

Hallo

Voeg je bestand toe zodat ik kan testen

1 like

Hallo

Hier is bijgevoegd mijn macro 

 


macro4.swp

Koel. Maar ik heb mijn code al, dus het helpt me niet echt:D Het is je SLDPRT-bestand dat ik nodig heb.

Hoewel de regels die u hebt toegevoegd problemen kunnen veroorzaken omdat de variabelen hieronder al zijn gedefinieerd.

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

 

Bijgevoegd is mijn dossier


Deel 1.SLDPRT

Het werkt inderdaad niet.
Maar dat is niet verwonderlijk, want het werkt ook niet door de functie handmatig aan te maken.
We zouden beperkingen moeten opleggen aan de entiteiten (vlak/hoekpunt) van de vaste stof.
De andere oplossing is om de vaste stof te verplaatsen van de coördinaten van het punt:

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