Funkcja InsertMoveCopyBody2

Witam

Chcę przesunąć mój kawałek reprezentowany przez nazwę scale1 utworzonego punktu (point1) w oryginalnym układzie współrzędnych

Wybieram 3 encje, ale kiedy moja funkcja jest wykonywana , nic się nie dzieje

Czy możesz mi pomóc

Dziękuję bardzo

Part.ClearSelection2 Prawda
boolstatus = Part.Extension.SelectByID2("Scale1", "BODYFEATURE", 0, 0, 0, Fałsz, 1, Nic, 0)
boolstatus = Part.Extension.SelectByID2("Punkt1", "DATUMPOINT", 0, 0, 0, Prawda, 2, Nic, 0)
boolstatus = Part.Extension.SelectByID2("Point1@Origine", "EXTSKETCHPOINT", 0, 0, 0, Prawda, 3, Nic, 0)


Przyciemnij funkcję jako obiekt

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

Witam, spróbuj tego:

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

 

Witam

Ciało jest dobrze dobrane na pierwszej linii frontu

Makro ulega awarii w następnym wierszu

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

 

 

Witam

Czy możesz mi pomóc z tym problemem?

Dziękuję

 

 

Witam

Załącz swój plik, abym mógł przetestować

1 polubienie

Witam

Tu załączam moje makro 

 


makro4.swp

Chłodny. Ale mam już swój kod, więc tak naprawdę mi to nie pomaga :D To twój plik SLDPRT, którego potrzebuję.

Chociaż dodane linie mogą powodować problemy, ponieważ zmienne są już zdefiniowane poniżej.

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

 

W załączeniu znajduje się mój plik


Część 1.SLDPRT

Rzeczywiście, to nie działa.
Ale nie jest to zaskakujące, ponieważ nie działa to również poprzez ręczne tworzenie funkcji.
Musielibyśmy nałożyć ograniczenia na elementy (ścianę/wierzchołek) bryły.
Innym rozwiązaniem jest przesunięcie bryły ze współrzędnych punktu:

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