| |
| KISTERS 3DViewStation - Der Schlüssel zur Einsparung von CAD-Lizenzen, eine Pressemitteilung
|
Autor
|
Thema: Linien aus geometrischen Set auslesen (2689 mal gelesen)
|
loisach Mitglied
Beiträge: 3 Registriert: 09.11.2012
|
erstellt am: 09. Nov. 2012 11:14 <-- editieren / zitieren --> Unities abgeben:
Hallo zusammen, ich bin auf dem Sektor CATIA-Makro schreiben noch ein komplett Anfänger. Ich brauche für meine Diplomarbeit ein Makro, was mir Linie (Verbindung von 2 Punkten) ausliehst. Das heißt so was in der Art ausgibt in einer .txt-Datei: Line.1 Point.1 Point.2 (das heißt Linie 1 geht von Punkt 1 nach Punkt 2) Line.2 Point.2 Point.3 .... Die Punkte ziehe ich schon mit einem anderen Makro, welches ich im Internet gefunden habe, aus catia. Das funktioniert so weit. Natürlich könnte ich auch mühseelig von Hand alle Linien mit den dazugehörigen Punkten rausschreiben, aber bei über 100 Punkten und noch mehr Verbindungslinien wird das ziemlich mühsam. Krönung wäre noch eine erste Zeile über der "Tabelle": Linien-Nr. Punkt 1 Punkt 2 Vielen Dank schon mal für eure Hilfe...
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: 09. Nov. 2012 12:50 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus Willkommen im Forum. Anbei ein Code-Schnippsel der dir den Namen der Linie ("Linie.1" in "Geometrisches Set.1") und der Punkt ausgibt. Code: Sub CATMain()Dim partDocument1 As partDocument Set partDocument1 = CATIA.ActiveDocument Dim part1 As part Set part1 = partDocument1.part Dim hybridBodies1 As hybridBodies Set hybridBodies1 = part1.hybridBodies Dim hybridBody1 As hybridBody Set hybridBody1 = hybridBodies1.Item("Geometrisches Set.1") Dim hybridShapes1 As Hybridshapes Set hybridShapes1 = hybridBody1.Hybridshapes Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Set hybridShapeLinePtPt1 = hybridShapes1.Item("Linie.1") MsgBox hybridShapeLinePtPt1.Name & " verbindet " & hybridShapeLinePtPt1.PtOrigine.DisplayName & " und " & hybridShapeLinePtPt1.PtExtremity.DisplayName End Sub
Du musst dir jetzt noch Gedanken mache wie du die Linien suchst und diese abarbeitest (zB Selektion und Schleife über die Selektion) und die Namen in eine Text-Datei ausgibst (siehe auch Forensuche nach ähnlichen Problemen)Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
loisach Mitglied
Beiträge: 3 Registriert: 09.11.2012
|
erstellt am: 09. Nov. 2012 13:32 <-- editieren / zitieren --> Unities abgeben:
So jetzt habe ich mal bersucht mein Punkte-Makro zuverstehen und dem entsprechende Teile in das Linien-Makro überzuführen. Raus gekommen ist das hier: Code: Const cDateiPfad = "C:\Documents and Settings\d2938\Desktop\linien_exp.txt" Function fFileExist() as Integer On Error Resume Next CATIA.FileSystem.GetFile (cDateiPfad) fFileExist = Err.Number End Function Sub CATMain() Dim Datei as File If fFileExist() <> 0 then Set Datei = CATIA.FileSystem.CreateFile (cDateiPfad, False) Else Set Datei = CATIA.FileSystem.GetFile (cDateiPfad) End If Dim mySelection as Selection Set mySelection = Catia.ActiveDocument.Selection Dim AnzahlSelekt as integer AnzahlSelekt = mySelection.count ' Gibt an wieviele Elemente selektiert wurden Dim DStrom as TextStream Set DStrom = Datei.OpenAsTextStream ("ForAppending") Dim partDocument1 As partDocument Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part Set part1 = partDocument1.part Dim hybridBodies1 As hybridBodies Set hybridBodies1 = part1.hybridBodies Dim hybridBody1 As hybridBody Set hybridBody1 = hybridBodies1.Item("Geometrisches Set.1") Dim hybridShapes1 As Hybridshapes Set hybridShapes1 = hybridBody1.Hybridshapes Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Set hybridShapeLinePtPt1 = hybridShapes1.Item("Linie.1") MsgBox hybridShapeLinePtPt1.Name & " verbindet " & hybridShapeLinePtPt1.PtOrigine.DisplayName & " und " & hybridShapeLinePtPt1.PtExtremity.DisplayName DStrom.Write ( "Name" & Chr(9) & "Punkt 1" & Chr(9) & "Punkt 2" & Chr(9)) Dim I as integer Dim oSelElem as Object For I = 1 to AnzahlSelekt Set oSelElem = hybridShapes1.Item DStrom.Write (hybridShapes1.Item.value.name & Chr(9) & hybridShapeLinePtPt1.PtOrigine.DisplayName & Chr(9) & hybridShapeLinePtPt1.PtExtremity.DisplayName & Chr(9)) Next DStrom.Close End Sub
Tun tut es noch nichts, bzw. es kommen immer Fehlermeldungen. Ich hatte schon massive Schwierigkeiten, das andere Makro zu verstehen und leider habe ich im Internet keine sinnvollen Tutorials dazu gefunden.... 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: 10. Nov. 2012 10:14 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus Anbei mein Code Vorschlag (ich musst gar nicht soviel verändern): Code: Option ExplicitConst cDateiPfad = "D:\linien_exp.txt" Sub CATMain()
Dim Datei As File If CATIA.FileSystem.FileExists(cDateiPfad) Then Set Datei = CATIA.FileSystem.GetFile(cDateiPfad) Else Set Datei = CATIA.FileSystem.CreateFile(cDateiPfad, False) End If Dim DStrom As TextStream Set DStrom = Datei.OpenAsTextStream("ForAppending") Dim partDocument1 As partDocument Set partDocument1 = CATIA.ActiveDocument Dim part1 As part Set part1 = partDocument1.part Dim hybridBodies1 As hybridBodies Set hybridBodies1 = part1.hybridBodies Dim hybridBody1 As hybridBody Set hybridBody1 = hybridBodies1.Item("Geometrisches Set.1") Dim hybridShapes1 As Hybridshapes Set hybridShapes1 = hybridBody1.Hybridshapes Dim hybridShapeLinePtPt1 As HybridShapeLinePtPt Dim I As Integer 'Überschrift schreiben DStrom.Write ("Name" & Chr(9) & "Punkt 1" & Chr(9) & "Punkt 2" & Chr(13) & Chr(10)) 'Schleife über alle Shapes im GeoSet For I = 1 To hybridShapes1.Count 'Typvergleich If TypeName(hybridShapes1.Item(I)) = "HybridShapeLinePtPt" Then Set hybridShapeLinePtPt1 = hybridShapes1.Item(I) 'Zeile schreiben DStrom.Write (hybridShapeLinePtPt1.Name & Chr(9) & hybridShapeLinePtPt1.PtOrigine.DisplayName & Chr(9) & hybridShapeLinePtPt1.PtExtremity.DisplayName & Chr(13) & Chr(10)) End If Next DStrom.Close End Sub
ggf musst du noch den Pfad zur Datei sowie den Namen des GeoSets anpassen. Die Aussage es gibt keine Tutorials lasse ich nicht stehen. VB und VBA gibt es genügend Material, und oft fehlt es an den Grundlagen (dann versteht man auch die V5Automation).Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
loisach Mitglied
Beiträge: 3 Registriert: 09.11.2012
|
erstellt am: 12. Nov. 2012 09:04 <-- editieren / zitieren --> Unities abgeben:
Vielen Dank für den verbeserten Code .... nach dem ich Pfad und "Geometrisches Set" umbenannt habe, funktioniert er jetzt. Wahrscheinlich habe ich bei meiner Tutorialsuche nicht nach dem richtigen gesucht und schon findet man nichts ... Manchmal sieht man den Wald vor lauter Bäumen nicht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 12. Jan. 2018 13:36 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Hallo zusammen, ich habe ein ähnliches Problem.Folgendes soll das Makro machen: Strukturbaum durchgehen und bestimmte Geo-Sets finden. Den Inhalt dieser Sets(Kurven,Linien etc.) kopieren. Habe das Makro soweit hinbekommen allerdings kopiert er die Elemente nicht. Vielleicht hat jemand den Lösungsansatz. Hier das Makro: Sub CATMain() set Sel = CATIA.ActiveDocument.Selection Sel.Search "CATGmoSearch.OpenBodyFeature,all"
For n = 1 to Sel.Count set Objekt = Sel.Item(n).Value name=Objekt.Name PSM= Mid(name,14,5) If PSM ="_PSM" then 'msgbox name
Set oPP = Sel.Item2(n) Set GetSelDoc = oPP.Value.Parent.Parent
partname=GetSelDoc.Name
Dim documents1 As Documents Set documents1 = CATIA.Documents
Dim partDocument1 As Document Set partDocument1 = documents1.Item(partname &".CATPart") Set part1 = partDocument1.Part
Dim part1 As Part Set part1 = partDocument1.Part Dim hybridBodies1 As hybridBodies Set hybridBodies1 = part1.hybridBodies
Dim hybridBody1 As hybridBody Set hybridBody1 = hybridBodies1.Item(name) Dim hybridShapes1 As Hybridshapes Set hybridShapes1 = hybridBody1.Hybridshapes For I = 1 To hybridShapes1.Count Set selection1 = partDocument1.selection
selection1.Clear set Objekt2=hybridShapes1.Item(I) name2=Objekt2.Name 'msgbox name2 Dim hybridShapeCurveExplicit1 As HybridShape Set hybridShapeCurveExplicit1 = hybridShapes1.Item(name2) selection1.Add hybridShapeCurveExplicit1 selection1.Copy Next End If next End Sub ------------------ Viele Grüße, Jerre95 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 14. Jan. 2018 15:36 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
|
bgrittmann Moderator Konstrukteur
Beiträge: 12005 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 14. Jan. 2018 18:59 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus Warum schränkst du denn die Suche nicht soweit ein dass nur die entsprechenden GeoSets gefunden werden? Dann könntest du innerhalb der gefundenen GeoSets nach den Elementen suchen. Beispiel: Code: Sub CATMain()Dim partDocument1 As Document Dim selection1 As Selection Dim TartgetHybridBody As HybridBody Set partDocument1 = CATIA.ActiveDocument Set selection1 = partDocument1.Selection selection1.Search "CATPrtSearch.OpenBodyFeature.Name='meinGeoSet',all" selection1.Search "(CATGmoSearch.Point + CATGmoSearch.Line),all" selection1.Copy selection1.Clear Set TartgetHybridBody = partDocument1.Part.HybridBodies.Item("Geometrisches Set.2") selection1.Add TartgetHybridBody selection1.PasteSpecial "CATPrtResultWithOutLink" End Sub
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 14. Jan. 2018 19:20 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Guten Abend, danke für die Antwort! Stimmt das könnte ich machen. Dann würde ich mir die If-Schleife innerhalb der Selektion sparen. Ist der Code den ich geschrieben habe so nicht möglich? Ist die zweite Selektion für die "hybrid shapes" denn richtig definiert? Wenn ich schreibe: Set productDocument1 = CATIA.ActiveDocument Set selection1 = productDocument1.Selection dann kopiert er mir die Elemente aus dem ersten gefundenen bzw. passendem Geo-Set, setzt dann aber leider die Sel.Count (Anzahl gefundener Geo-Sets) zurück und steigt aus. Da die Zählvariable n größer ist als die Anzahl gefundener Sets. Irgendwie komisch. ------------------ Viele Grüße, Jerre95 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: 14. Jan. 2018 19:28 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus Es gibt nur eine Selektion. (ganz egal wie viele Variablen/Objekte du dafür definiert hast) Sobald du was kopierst ist das Ergebnis deiner Suche hinfällig. In so einem Fall kann man zB das Ergebnis der Suche in einem Array7Collection zwischenspeichern und später wieder neu selektieren bzw verwenden. Der Code der Makroaufzeichnung ist oft auch unnötig komplex. zB greifst du immer über den Namen auf das Objekt/Dokument zu obwohl du es zuvor schon hast. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 14. Jan. 2018 19:36 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Verstehe! Dann ist es also wesentlich einfacher das richtige Geo-Set (auch wenn mehrere zutreffen?) zu suchen und dann innerhalb des Geo-Sets eine weitere Suche zu starten. ( hier sollten dann alle Elemente innerhalb des Sets gefunden werden, also nicht nur Punkte und Linien). ------------------ Viele Grüße, Jerre95 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: 15. Jan. 2018 10:34 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus Nicht unbedingt. Das kommt immer auf den Anwendungsfall an. Falls du alle HybridShapes kopieren möchtest kannst du diese auch per Schleife der Selektion zufügen. zB Code: oselection.clearfor i = 1 to SourceHybridBody.Hybridshapes.Count oselection.add SourceHybridBody.Hybridshapes.Item(i) next oselection.Copy
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 16. Jan. 2018 19:15 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Guten Abend, herzlichen Dank für die viele Hilfe! Die Idee mit der Kollektion war dann letztendlich erfolgreich! Danke! (Kann den Code dann auch gerne der Allgemeinheit posten) Besteht denn darüber hinaus die Möglichkeit, bevor das Element kopiert wird, zu überprüfen ob es veröffentlicht ist ? Wenn nein, dann das Element veröffentlichen. Darüber hinaus ist mir aufgefallen, wenn das Element sich in einem Sammelkörper (Multiselektion) befindet, selektiert das Makro diese Elemente nicht. Gibt es hierfür auch einen Trick? Vorab danke für die Hilfe! ------------------ Viele Grüße, Jerre95 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Jerre95 Mitglied
Beiträge: 27 Registriert: 04.12.2017 CATIA V5 R24
|
erstellt am: 17. Jan. 2018 16:58 <-- editieren / zitieren --> Unities abgeben: Nur für loisach
Servus, hiermit versuche ich die Elemente zu veröffentlichen: Denke der Fehler liegt darin, dass ich das Makro aus der obersten Baugruppe hinaus starte und die Elemente ja im Part (in welchem die zu veröffentlichen Elemente liegen) veröffentlicht werden müssen. Set product6 =CATIA.ActiveDocument.Product For I = 1 To hybridShapes1.Count Dim Objekt2 As HybridShape set Objekt2=hybridShapes1.Item(I) name2=Objekt2.Name Dim hybridShapeCurveExplicit1 As HybridShape Dim curve As HybridShape Set curve = hybridShapes1.Item(name2) Dim Reference As Reference Dim publications1 As Publications Dim publication1 As Publication Set Reference = product6.CreateReferenceFromName(partname&"/!"&name&name2) Set publications1 = product6.Publications Set publication1 = publications1.Add(name2) —> hier ist der Fehler publications1.SetDirect name2, Reference selection1.Add curve selection1.copy ------------------ Viele Grüße, Jerre95 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |