| |
| KISTERS 3DViewStation: Mit 3D-Montageanleitungen werden Produkte bei der Fertigung lebendig, eine Pressemitteilung
|
Autor
|
Thema: Mirror/symmetry all bodies ----spiegeln alle Körper (5120 mal gelesen)
|
appvid Mitglied DESIGNER
Beiträge: 9 Registriert: 28.08.2012 Model-HP Z500 Processor-Interl Xeon 2.93GhZ Type-64bit RAM 12GB CATIA-R20 MS VB 6.5
|
erstellt am: 14. Nov. 2012 03:08 <-- editieren / zitieren --> Unities abgeben:
|
tberger Mitglied Application Manager CATIA V5 / V6
Beiträge: 1385 Registriert: 13.01.2007 WIN 7 64bit V5R21SP3HF49 3DX/V6 R2016x
|
erstellt am: 14. Nov. 2012 07:35 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Hi appvid, here is some code for body mirroring, HTH. Sub CATMain() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument Dim part1 As Part Set part1 = partDocument1.Part Dim bodies1 As Bodies Set bodies1 = part1.Bodies Dim shapeFactory1 As ShapeFactory Set shapeFactory1 = part1.ShapeFactory Dim originElements1 As OriginElements Set originElements1 = part1.OriginElements Dim hybridShapePlaneExplicit1 As HybridShapePlaneExplicit Set hybridShapePlaneExplicit1 = originElements1.PlaneZX Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) Dim symmetry1 As Symmetry Dim hybridShapeSymmetry1 As HybridShapeSymmetry Dim MyBody As Body Dim Startnumber_Bodies As Integer Startnumber_Bodies = bodies1.count Dim I As Integer For I = 1 To Startnumber_Bodies Set MyBody = bodies1.Item(I) part1.InWorkObject = MyBody Set symmetry1 = shapeFactory1.AddNewSymmetry2(reference1) Set hybridShapeSymmetry1 = symmetry1.HybridShape Next part1.Update End Sub ------------------ Grüße aus dem Thurgau Thomas +++++++++++++++++++++++++++++++++ CATIA - eine Laune der Natur ... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
appvid Mitglied DESIGNER
Beiträge: 9 Registriert: 28.08.2012 Model-HP Z500 Processor-Interl Xeon 2.93GhZ Type-64bit RAM 12GB CATIA-R20 MS VB 6.5
|
erstellt am: 11. Dez. 2012 00:34 <-- editieren / zitieren --> Unities abgeben:
Hello Thomas I did little improvements to your code. This script will mirror all feature in a part (including geosets and bodies). Could some one help me to use "isolate(no datum)- No keep Mode". Means when I mirror features in a geoset, graphical properties will be copied to respective children and Parents will get deleted. ----------------------- Sub CATMain() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part Set part1 = partDocument1.Part Dim bodies1 As Bodies 'solids Set bodies1 = part1.Bodies Dim shapeFactory1 As ShapeFactory 'solids Set shapeFactory1 = part1.ShapeFactory Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Dim hybridShapeFactory1 As HybridShapeFactory Set hybridShapeFactory1 = part1.HybridShapeFactory Dim hybridBody1 As HybridBody Dim originElements1 As OriginElements Set originElements1 = part1.OriginElements Dim hybridShapePlaneExplicit1 As HybridShapePlaneExplicit Set hybridShapePlaneExplicit1 = originElements1.PlaneZX Dim referenceplane As Reference Set referenceplane = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) Dim hybridShapeSymmetry1 As HybridShapeSymmetry '========================= for solids mirror Dim noofbodies As Integer Dim a As Integer noofbodies = bodies1.Count Dim body1 As Body Dim symmetry1 As Symmetry For a = 1 To noofbodies Set body1 = bodies1.Item(a) 'MsgBox (body1.Shapes.Count) If body1.Shapes.Count > 0 Then part1.InWorkObject = body1 Set symmetry1 = shapeFactory1.AddNewSymmetry2(referenceplane) Set hybridShapeSymmetry1 = symmetry1.HybridShape End If 'MsgBox body1.Shapes.Count Next '--------- '------------- for geo sets mirror Dim I, j As Integer '======================================================================== For I = 1 To hybridBodies1.Count Set hybridBody1 = hybridBodies1.Item(I) Dim HybridShapes1 As HybridShapes Dim HybridShape1 As HybridShape For j = 1 To hybridBody1.HybridShapes.Count Set HybridShapes1 = hybridBody1.HybridShapes Set HybridShape1 = HybridShapes1.Item(j) 'MsgBox HybridShape1.Name Dim selection1 As Selection Set selection1 = partDocument1.Selection Dim visPropertySet1 As VisPropertySet Set visPropertySet1 = selection1.VisProperties selection1.Add HybridShape1 visPropertySet1.SetShow 0 Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(HybridShape1) Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference2, referenceplane) hybridBody1.AppendHybridShape hybridShapeSymmetry1 next next end sub thanks very much appvid(var)
[Diese Nachricht wurde von appvid am 11. Dez. 2012 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 21. Jul. 2016 17:22 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Hey! Ich habe ein ähnliches Anliegen. Ich möchte gern aus einer vorangegangenen User-Selection der Spiegelebene ein Symmetry des PartBody erstellen. Leider bricht mein Skript in der markierten Zeile ab. Code: TargetSelection.Search "CATPrtSearch.BodyFeature,all" 'es gibt nur 1 Body (PartBody) im Bauteil. Eventuell gibt es auch eine Methode, den PartBody direkt zu adressieren?'Spiegelebene auswaehlen '--------------------------------------------------------------------------------------------- set Sel = CATIA.ActiveDocument.Selection dim ObjektTyp(1) ObjektTyp(0) = "Plane" ObjektTyp(1) = "Face" Sel.Clear do Auswahl = Sel.SelectElement2(ObjektTyp,"Waehle eine Spiegelflaeche aus..." , false) if Auswahl = "Normal" then set Objekt = Sel.item(1) Fertig = true else Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _ "Das Makro wurde beendet!", 48, "Benutzerabbruch") exit Sub end if loop until Fertig = true 'Symmetry anlegen '--------------------------------------------------------------------------------------------- Set symmetry1 = shapeFactory1.AddNewSymmetry2(Objekt) ' hier bricht das Skript ab Set hybridShapeSymmetry1 = symmetry1.HybridShape
Hat jemand mehr Erfahrung als ich und kann mir helfen? Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 21. Jul. 2016 17:50 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Die Methode "AddNewSymmetry2" verlangt eine "Reference" und nicht das Objekt (Ebene) selbst. ggf reicht folgende Änderung: Code: set Objekt = Sel.item2(1).Reference
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 22. Jul. 2016 08:02 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Guten Morgen! Das hat leider nicht geklappt.
Code: TargetSelection.Search "CATPrtSearch.BodyFeature,all" 'gibt es eine Möglichkeit, den PB direkt zu adressieren? 'Spiegelebene auswaehlen '--------------------------------------------------------------------------------------------- set Sel = CATIA.ActiveDocument.Selection dim ObjektTyp(1) ObjektTyp(0) = "Plane" ObjektTyp(1) = "Face" Sel.Clear do Auswahl = Sel.SelectElement2(ObjektTyp,"Waehle eine Spiegelflaeche aus..." , false) if Auswahl = "Normal" then set Objekt = Sel.item(1) Fertig = true else Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _ "Das Makro wurde beendet!", 48, "Benutzerabbruch") exit Sub end if loop until Fertig = true
'Symmetry anlegen '--------------------------------------------------------------------------------------------- set Objekt = Sel.item2(1).Reference Set symmetry1 = shapeFactory1.AddNewSymmetry2(Objekt) 'Skript bricht immer noch an dieser Stelle ab. Set hybridShapeSymmetry1 = symmetry1.HybridShape
Ich habe auch versucht, die Zeile Code: set Objekt = Sel.item(1)
in der Userselection zu ändern. Leider ebenfalls ohne Erfolg. Hat noch jemand eine Idee? Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Jul. 2016 08:32 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Also bei mir hat die Referenzebildung über: Code: set Objekt = Sel.item2(1).Reference
geklappt. Was hast du gewählt? Willst du wirklich bei der Userselection eine Fläche (Face) zulassen? Was ist wenn diese nicht planar ist? Was willst du mit der Zeile "TargetSelection.Search"Gruß Bernd PS: Ist shapeFactory1 irgendwo definiert/deklariert? ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 22. Jul. 2016 08:51 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
EDIT: Ich habe dein PS zu spät gelesen ;-) Daran lag es! Ich gebe dir vollkommen Recht. Wenn die Face nicht planar ist, sieht es schlecht aus. Aber ich appelliere an den Verstand der Anwender, das eine Spiegelebene/-fläche planar sein sollte. Leider haben wir viele Teile, die achsensystemfern und ohne Referenzgeometrie konstruiert wurden. Das macht eine Selektion nur über eine Ebene ziemlich schwer. Jetzt meckert er allerdings, sobald ich eine Fläche selektiere. Er schafft es nicht, diese als Referenz zu für das Symmetry zu nutzen. Mit einer Plane funktioniert es. Hast du nochmal einen Denkanstoß für mich?
Code: Language="VBSCRIPT"Sub CATMain() 'Kopieren des Original PartBody '--------------------------------------------------------------------------------------------- Set documents1 = CATIA.Documents Set SourcePartDocument = CATIA.ActiveDocument Set SourceSelection = SourcePartDocument.Selection SourceSelection.Clear SourceSelection.Add SourcePartDocument.part.mainbody SourceSelection.Copy 'Erzeugen eines neuen Parts '--------------------------------------------------------------------------------------------- Set TargetPartDocument = documents1.Add("Part")
'Einfuegen des kopierten Bodies As Result With Link '--------------------------------------------------------------------------------------------- Set TargetSelection = TargetPartDocument.selection Set TargetPart = TargetPartDocument.Part TargetSelection.clear TargetSelection.Add TargetPart TargetSelection.PasteSpecial "CATPrtResult" TargetPart.Update
'Kopierten Body als PartBody setzen '--------------------------------------------------------------------------------------------- Set bodies1 = TargetPart.Bodies Set body2 = bodies1.Item(bodies1.count) TargetPart.MainBody = body2
'leeren Body löschen '--------------------------------------------------------------------------------------------- TargetSelection.clear for x = TargetPart.bodies.count to 1 step -1 Set oBody = TargetPart.bodies.item(x) if oBody.shapes.count =0 then TargetSelection.add oBody TargetSelection.delete TargetSelection.clear end if next
'neuer PartBody umbenannt '--------------------------------------------------------------------------------------------- TargetSelection.Search "CATPrtSearch.BodyFeature,all" TargetPartDocument.part.mainbody.name = "PartBody"
'Spiegelebene auswaehlen '--------------------------------------------------------------------------------------------- set Sel = CATIA.ActiveDocument.Selection dim ObjektTyp(1) ObjektTyp(0) = "Plane" ObjektTyp(1) = "Face" Sel.Clear do Auswahl = Sel.SelectElement2(ObjektTyp,"Waehle eine Spiegelflaeche aus..." , false) if Auswahl = "Normal" then set Objekt = Sel.item(1) Fertig = true else Box = MsgBox("Die Selektion wurde abgebrochen" + Chr(10) + _ "Das Makro wurde beendet!", 48, "Benutzerabbruch") exit Sub end if loop until Fertig = true
'Symmetry anlegen '--------------------------------------------------------------------------------------------- Set shapeFactory1 = TargetPart.ShapeFactory set Objekt = Sel.item2(1).Reference Set symmetry1 = shapeFactory1.AddNewSymmetry2(Objekt) Set hybridShapeSymmetry1 = symmetry1.HybridShape
'neuer PartBody in Work '--------------------------------------------------------------------------------------------- TargetPart.InWorkObject = body2 TargetPart.Update
'Axis System ins hide '--------------------------------------------------------------------------------------------- TargetSelection.Search "CATPrtSearch.AxisSystem,all" Set visProperties1 = TargetSelection.VisProperties visProperties1.SetShow catVisPropertyNoShowAttr
'Elemente abwaehlen '--------------------------------------------------------------------------------------------- TargetSelection.Clear CATIA.StartCommand "Fit All In" CATIA.RefreshDisplay = True
End Sub
[Diese Nachricht wurde von DuffM4nUS am 22. Jul. 2016 editiert.] [Diese Nachricht wurde von DuffM4nUS am 22. Jul. 2016 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Jul. 2016 12:01 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Wenn du eine Fläche wählen willst muss wohl die Reference über einen BREP-Zugriff erfolgen. (ggf kannst du dies auch mit dem Makrorekorder aufnehmen) BREP-Zugriffe sind aber sehr komplex. Ich selbst hab dass immer vermieden. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 25. Jul. 2016 13:32 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Ich habe das über den Makrorecorder versucht. Dieser liefert natürlich ein statisches Ergebnis (exakt die Fläche, welche exakt dieses Bauteil hat). Ich bin nicht in der Lage, die Bezeichnung der Referenzfläche in eine dynamische Bezeichnung (gültig für alle Bauteile) zu überführen. Die Suche liefert auch keine für mich brauchbaren Ergebnisse. Bisher habe ich folgendes Codeschnipsel, welches an der Funktion LEFT hängen bleibt. "Compile Error: Wrong number of argruments or invalid property assignment" VBA: Hat jemand eine Idee, wie ich die User-selection durchführen könnte?
Code: 'Select Mirror Plane 'Select Mirror Plane '--------------------------------------------------------------------------------------------- Set sel = CATIA.ActiveDocument.Selection Dim ObjectType(0) ObjectType(0) = "Face" sel.Clear Do Selection = sel.SelectElement2(ObjectType, "Select a planar Face...", False) If Selection = "Normal" Then Set Object = sel.Item(1).Value ready = True Else Box = MsgBox("Selection was cancelled. Macro will be cancelled." + Chr(10) + _ "Macro was cancelled!", 48, "User Cancellation") Exit Sub End If Loop Until ready = True 'Symmetry '--------------------------------------------------------------------------------------------- Set shapeFactory1 = TargetPart.ShapeFactory Dim Refer As Reference Set Refer = TargetPart.CreateReferenceFromBRepName(GetBrep(Object.Name), Object.Parent) Set symmetry1 = shapeFactory1.AddNewSymmetry2(Ref1) Set hybridShapeSymmetry1 = symmetry1.HybridShape
'-----------------------------------------------------------
Public Function GetBrep(MyBRepName As String) As String MyBRepName = Replace(MyBRepName, "Selection_", "") MyBRepName = Left(MyBRepName, InStrRev(MyBRepName, "));")) MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)" GetBrep = MyBRepName End Function
[Diese Nachricht wurde von DuffM4nUS am 25. Jul. 2016 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Mitglied Freiberuflicher Konstrukteur
Beiträge: 1057 Registriert: 25.11.2006 Win7 Pro 64 + Ubuntu + Irix6.5.20 Dell Precision M6600 i7-2960XM 2.7GHz 16GB NVidia Quadro M5010 Catia V5R19 VB6Pro.SP6/VBA 6.5.1053
|
erstellt am: 25. Jul. 2016 14:12 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
|
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 25. Jul. 2016 15:17 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Hey! Das hat leider nicht geklappt. Bleibt an der selben Stelle stecken. Markiert wird bei der Analyse: Code: Public Function GetBrep(MyBRepName As String) As String MyBRepName = Replace(MyBRepName, "Selection_", "") Dim iStart As Integer iStart = InStrRev(MyBRepName, "));") MyBRepName = Left(MyBRepName, iStart) MyBRepName = MyBRepName + ");WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)" GetBrep = MyBRepName End Function
Fehlermeldung wie oben beschrieben. Ich bin am Ende meines Latein
User-Selection ist halt doch was für Profis Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Mitglied Freiberuflicher Konstrukteur
Beiträge: 1057 Registriert: 25.11.2006 Win7 Pro 64 + Ubuntu + Irix6.5.20 Dell Precision M6600 i7-2960XM 2.7GHz 16GB NVidia Quadro M5010 Catia V5R19 VB6Pro.SP6/VBA 6.5.1053
|
erstellt am: 25. Jul. 2016 15:24 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
|
DuffM4nUS Mitglied Konstrukteur
Beiträge: 26 Registriert: 14.04.2016 @ WORK CATIA V5 R19 SP9 Windows 7 x64 Professional SP1 i7-3740 @ 2.7GHz 16GB RAM NVIDIA Quadro 3000M 500GB SHDD
|
erstellt am: 25. Jul. 2016 15:51 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Danke für deine Bemühungen! Ich muss gestehen, ich bin ich Newb und habe den Code hier: http://www.coe.org/p/fo/et/thread=27257 und hier: http://www.grozeaion.com/catia-v5/v5-programming/112-useful-catia-vba-functions.html kopiert. Ich habe ehrlich gesagt keine Ahnung, wie die korrekte Bezeichnung sein sollte. Ich habe versucht, den Code aus den Quellen anzupassen, aber darin bin ich ja wohl gescheitert. Mein Ziel wäre, das Symmetry Feature durch eine User-Selektion der Eingabefläche zu automatisieren. Mit Planes klappt das super. Sobald aber BREP-Zugriff erforderlich ist, geht nix mehr. Der Original-String vom Makrorecorder sieht so aus: Code: Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Solid.1;%4);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", solid1)
Das Problem ist echt an der Sache, dass ich nicht wirklich Ahnung habe, was ich da tue. Und das ist meist keine gute Voraussetzung Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 25. Jul. 2016 16:13 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Lass dir mal den Inhalt der Stings als MsgBox ausgeben. Übergibst du der Funktion einen BREP-String? Was fehlt, dass der String in deiner Makroaufzeichnung herauskommt? Übergibst du das richtige an die Funktion? (wenn du diese fragen für dich selbst geklärt hast, hast du ggf schon den Code verstanden) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Mitglied Freiberuflicher Konstrukteur
Beiträge: 1057 Registriert: 25.11.2006 Win7 Pro 64 + Ubuntu + Irix6.5.20 Dell Precision M6600 i7-2960XM 2.7GHz 16GB NVidia Quadro M5010 Catia V5R19 VB6Pro.SP6/VBA 6.5.1053
|
erstellt am: 25. Jul. 2016 16:32 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Code: Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Solid.1;%4);None:();Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", solid1)
Das dürfte nicht der Original-String sein, sonst müsste am Schluss 'Solid.1' stehen. Das ist der name des angewählten Solids; '%4' ist die interne Bezeichnung der angeklickten Face. Tschau, Joe ------------------ Inoffizielle Catia Hilfeseite Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
olleiCAD Mitglied
Beiträge: 59 Registriert: 24.04.2018 Catia V5 R32 SP2 | Windows 10 Pro
|
erstellt am: 24. Jul. 2018 12:00 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Code: Sub CATMain() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part Set part1 = partDocument1.Part Dim bodies1 As Bodies 'solids Set bodies1 = part1.Bodies Dim shapeFactory1 As ShapeFactory 'solids Set shapeFactory1 = part1.ShapeFactory Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Dim hybridShapeFactory1 As HybridShapeFactory Set hybridShapeFactory1 = part1.HybridShapeFactory Dim hybridBody1 As HybridBody Dim originElements1 As OriginElements Set originElements1 = part1.OriginElements Dim hybridShapePlaneExplicit1 As HybridShapePlaneExplicit Set hybridShapePlaneExplicit1 = originElements1.PlaneZX Dim referenceplane As Reference Set referenceplane = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) Dim hybridShapeSymmetry1 As HybridShapeSymmetry '========================= for solids mirror Dim noofbodies As Integer Dim a As Integer noofbodies = bodies1.Count Dim body1 As Body Dim symmetry1 As Symmetry For a = 1 To noofbodies Set body1 = bodies1.Item(a) 'MsgBox (body1.Shapes.Count) If body1.Shapes.Count > 0 Then part1.InWorkObject = body1 Set symmetry1 = shapeFactory1.AddNewSymmetry2(referenceplane) Set hybridShapeSymmetry1 = symmetry1.HybridShape End If 'MsgBox body1.Shapes.Count Next '--------- '------------- for geo sets mirror Dim I, j As Integer '======================================================================== For I = 1 To hybridBodies1.Count Set hybridBody1 = hybridBodies1.Item(I) Dim HybridShapes1 As HybridShapes Dim HybridShape1 As HybridShape For j = 1 To hybridBody1.HybridShapes.Count Set HybridShapes1 = hybridBody1.HybridShapes Set HybridShape1 = HybridShapes1.Item(j) 'MsgBox HybridShape1.Name Dim selection1 As Selection Set selection1 = partDocument1.Selection Dim visPropertySet1 As VisPropertySet Set visPropertySet1 = selection1.VisProperties selection1.Add HybridShape1 visPropertySet1.SetShow 0 Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(HybridShape1) Set hybridShapeSymmetry1 = hybridShapeFactory1.AddNewSymmetry(reference2, referenceplane) hybridBody1.AppendHybridShape hybridShapeSymmetry1 next next end sub
Hallo Zusammen, der Code spiegelt bei mir alle Bodys, was soweit schon mal gut ist. Jedoch auch die Bodies, die mit boolschen Operationen versehen sind und praktisch in einem Body sind. Wie müsste der Code lauten, damit er nur die "obersten Bodies" spiegelt? (Siehe Anhang) Wäre mir eine riesen Hilfe. Vielen Dank schon mal. [Diese Nachricht wurde von olleiCAD am 24. Jul. 2018 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 24. Jul. 2018 14:36 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Du könntest vor dem Spiegeln des Bodies diesen mit InBooleanOperation prüfen, ob dieser in einer Boole'schen Operation verwendet wird und dann entsprechend überspringen. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
olleiCAD Mitglied
Beiträge: 59 Registriert: 24.04.2018 Catia V5 R32 SP2 | Windows 10 Pro
|
erstellt am: 03. Apr. 2019 09:04 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Noch eine Frage: Ich will dass mir dieses makro alle ausgewählten Körper über eine Ebene spiegeln, die der benutzer durch Auswahl festlegen soll. Klappt aber leider nicht.... woran liegts? Code: Sub CATMain() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part Set part1 = partDocument1.Part Dim bodies1 As Bodies 'solids Set bodies1 = part1.Bodies Dim shapeFactory1 As ShapeFactory 'solids Set shapeFactory1 = part1.ShapeFactory Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Dim hybridShapeFactory1 As HybridShapeFactory Set hybridShapeFactory1 = part1.HybridShapeFactory Dim hybridBody1 As HybridBody Dim originElements1 As OriginElements Set originElements1 = part1.OriginElements Dim hybridShapePlaneExplicit1 As HybridShapePlaneExplicit Dim referenceplane As Reference
Dim hybridShapeSymmetry1 As HybridShapeSymmetry
Dim UserSelection As Selection Set UserSelection = CATIA.ActiveDocument.Selection '==== Ebene auswählen Dim PlanePruef as CATBSTR Dim PlaneSelection As Selection Set PlaneSelection = CATIA.ActiveDocument.Selection PlaneSelection.Clear Dim Was(1) Was(0) = "OriginElements" Was(1) = "Plane"
PlanePruef = PlaneSelection.SelectElement2 (Was, "Ebene auswählen", False) If PlanePruef = "Normal" Then Set hybridShapePlaneExplicit1 = PlaneSelection.Item(1).Value Set referenceplane = part1.CreateReferenceFromObject(hybridShapePlaneExplicit1) Else MsgBox ("Fehler") End If PlaneSelection.Clear '========================= for solids mirror Dim noofbodies As Integer Dim a As Integer noofbodies = UserSelection.Count
Dim body1 As Body Dim symmetry1 As Symmetry For a = 1 To noofbodies Set body1 = UserSelection.Item(a).Value If body1.InBooleanOperation = false Then 'MsgBox (body1.Shapes.Count) If body1.Shapes.Count > 0 Then part1.InWorkObject = body1 Set symmetry1 = shapeFactory1.AddNewSymmetry2(referenceplane) Set hybridShapeSymmetry1 = symmetry1.HybridShape End If 'MsgBox body1.Shapes.Count Else End If Next end sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 03. Apr. 2019 18:34 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Wo selektierst du den die Körper? Nach der Selektion der Spiegelebene ist die Selektion leer. Also müsst du dort eine erneute Userselection einbauen. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
olleiCAD Mitglied
Beiträge: 59 Registriert: 24.04.2018 Catia V5 R32 SP2 | Windows 10 Pro
|
erstellt am: 04. Apr. 2019 07:23 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
|
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 04. Apr. 2019 08:39 <-- editieren / zitieren --> Unities abgeben: Nur für appvid
Servus Nein, denn es gibt nur eine Selektion. Durch eine Userselection, Search oder ähnliches wird diese verändert, und deine zuvor selektierten Element sind dies nicht mehr. Also entweder Reihenfolge ändern (erste Ebene, dann Körper) oder die selektierten Elemente vom Anfang zwischenspeichern (zB Array) Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |