Autor
|
Thema: Makro Bauteil schneiden (1442 mal gelesen)
|
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 21. Aug. 2020 23:03 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe Community, ich habe ein Makro erstellt, um ein Bauteil entlang einer gekrümmten Kontur zu schneiden. Der Schnitt soll jeweils normal zur Bauteiloberfläche positioniert sein und der Abstand der Schnitte frei wählbar. In folgendem Makro bekomme ich den Fehler: Compile Error - Procedure too large Aufgenommen habe ich es mit dem Makro Recorder, es soll zunächst nur die Schnittebenen definieren. Leider bin ich blutiger Anfänger in der VBA Programmierung und hoffe auf Feedback. Liebe Grüße
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 21. Aug. 2020 23:05 <-- editieren / zitieren --> Unities abgeben:
|
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Aug. 2020 07:25 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus slueck Willkommen im Forum. Nach der Fehlermeldung nach ist der Code viel zu groß/lang für eine Routine (wusste gar nicht das es da eine Grenze gibt). Soweit ich den Code verstehe, willst du auf einer Kurve Punkte erzeugen und darauf Ebenen legen. Statt den Code mehrfach einzufügen bietet sich da eher eine Schleife an (for-next). Hast du die Aufzeichnung auch mal probiert ob diese läuft (vor dem vervielfältigen)? Mir fallen da einige Punkte auf die mir komisch vorkommen. Ich bitte dich erst zumindest die Grundlagen von VBA anzuschauen. Dann mal ein Makro aufzeichnen und versuchen abzuspielen und nachvollziehen. Erst dann würde ich den Code weiter ausbauen. Gruß Bernd PS: Kannst du mal ein Bild des Parts posten? Dann kann ich dir ggf weiter Tipps geben ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 22. Aug. 2020 15:27 <-- editieren / zitieren --> Unities abgeben:
Hallo bgrittmann, der Code den du dir angeschaut hast ist eigenständig von CATIA über das Tool Makro Aufzeichnen erstellt worden. Sprich das Tool erstellt keine Schleife. Ich habe zur Erzeugung der Ebenen (Pattern) die Funktion Punktewiederholung benutzt als ich das Makro aufgezeichnet habe. Wenn ich richtig verstehe muss ich nun eine Schleife erstellen die die einzelnen Anweisungen aus dem aufgezeichneten Makro abarbeitet. Hier noch ein Bild: Danke für deine Antwort, lieber Gruß
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Aug. 2020 15:43 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Der Code der Makroaufzeichnung ist manchmal etwas "sonderbar" und nicht unbedingt "sauber". Hier ein Beispiel wie das mit einer Schleife aussehen könnte: Code: Sub CATMain()Dim oPartDocument As Document Dim oPart As Part Dim oHybridBodies As HybridBodies Dim ohybridBody As HybridBody Dim oHybridShapes As HybridShapes Dim oSpline As HybridShape Dim ohybridBodyPlanes As HybridBody Dim oHybridShapeFactory As Factory Dim oPointOnCurve As HybridShapePointOnCurve Dim refSpline As Reference Dim i as Integer Dim iPlanesCount as Integer Dim refPoint As Reference Dim oPlaneNormal As HybridShapePlaneNormal Dim dSpacing as Double 'Werte festlegen iPlanesCount = 5 'Anzahl der Ebenen/Punkte dSpacing = 10 'Abstand in mm 'Vorbereitungen Set oPartDocument = CATIA.ActiveDocument Set oPart = oPartDocument.Part Set oHybridBodies = oPart.HybridBodies Set ohybridBody = oHybridBodies.Item("Geometrisches Set.1") Set oHybridShapes = ohybridBody.HybridShapes Set oSpline = oHybridShapes.Item("Spline.1") 'Set oSpline = oHybridShapes.Item("Kreis.1") Set oHybridShapeFactory = oPart.HybridShapeFactory Set refSpline = oPart.CreateReferenceFromObject(oSpline) Set ohybridBodyPlanes = oHybridBodies.Item("Planes") 'Punkte/Ebenen erzeugen for i = 1 to iPlanesCount Set oPointOnCurve = oHybridShapeFactory.AddNewPointOnCurveFromDistance(refSpline, dSpacing * i, False) oPointOnCurve.DistanceType = 1 ohybridBodyPlanes.AppendHybridShape oPointOnCurve Set refPoint = oPart.CreateReferenceFromObject(oPointOnCurve) Set oPlaneNormal = oHybridShapeFactory.AddNewPlaneNormal(refSpline, refPoint) ohybridBodyPlanes.AppendHybridShape oPlaneNormal oPart.Update next End Sub
Viel Spaß beim analysieren, verstehen und an deine Bedürfnisse anpassen. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 22. Aug. 2020 16:15 <-- editieren / zitieren --> Unities abgeben:
Danke Dir vielmals für die schnelle Antwort. Funktioniert wunderbar. Wahnsinn, in welcher Geschwindigkeit du das geschrieben hast. Ich werde über die Hilfe im VB Editor erstmal alle Syntax Befehle nachlesen um sie besser zu verstehen und dann im nächsten Schritt Sections auf Basis der Ebenen erstellen. Ich danke Dir vielmals und ich melde mich erneut wenn ich weiter bin mit den Sections. : ) LG Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 24. Aug. 2020 21:40 <-- editieren / zitieren --> Unities abgeben:
Soweit so gut, das Macro funktioniert auf Partebene, sobald ich jedoch Sections einfügen möchte muss ich dies mit der DMU Space Analysis machen, welche nur auf Product Ebene funktioniert. Hier komme ich nicht weiter, das Part muss im Produkt selektiert werden. Ich habe das Forum durchforstet um die Logik dahinter zu verstehen aber leider keinen passenden Eintrag gefunden. Auf Part Ebene funktioniert dieser Code:
Sub CATMain()
'Variablen festlegen Dim oPartDocument As Document Dim oPart As Part Dim oHybridBodies As HybridBodies Dim ohybridBody As HybridBody Dim oHybridShapes As HybridShapes Dim oSpline As HybridShape Dim ohybridBodyPlanes As HybridBody Dim oHybridShapeFactory As Factory Dim oPointOnCurve As HybridShapePointOnCurve Dim refSpline As Reference Dim i As Integer Dim iPlanesCount As Integer Dim refPoint As Reference Dim oPlaneNormal As HybridShapePlaneNormal Dim dSpacing As Double 'Werte festlegen iPlanesCount = 60 'Anzahl der Ebenen/Punkte dSpacing = 50 'Abstand in mm
'Vorbereitungen Set oPartDocument = CATIA.ActiveDocument Set oPart = oPartDocument.Part Set oHybridBodies = oPart.HybridBodies Set ohybridBody = oHybridBodies.Item("Geometrisches Set.1") Set oHybridShapes = ohybridBody.HybridShapes 'Set oSpline = oHybridShapes.Item("Spline.1") Set oSpline = oHybridShapes.Item("Circle.1") Set oHybridShapeFactory = oPart.HybridShapeFactory Set refSpline = oPart.CreateReferenceFromObject(oSpline) Set ohybridBodyPlanes = oHybridBodies.Item("Planes")
'Punkte/Ebenen erzeugen For i = 1 To iPlanesCount Set oPointOnCurve = oHybridShapeFactory.AddNewPointOnCurveFromDistance(refSpline, dSpacing * i, False) oPointOnCurve.DistanceType = 1 ohybridBodyPlanes.AppendHybridShape oPointOnCurve Set refPoint = oPart.CreateReferenceFromObject(oPointOnCurve) Set oPlaneNormal = oHybridShapeFactory.AddNewPlaneNormal(refSpline, refPoint) ohybridBodyPlanes.AppendHybridShape oPlaneNormal oPart.Update
Next
End Sub
Auf Product Ebene dieser:
Sub CATMain() 'Language = "MSVBScript" ' COPYRIGHT DASSAULT SYSTEMES 2001 'Option Explicit ' *********************************************************************** ' Purpose : Create a network of sections. ' Assumptions : A CATProduct document should be active. ' Author : ' Languages : VBScript ' Locales : English ' CATIA Level : V5R6 ' *********************************************************************** Dim iNumber ' Number of sections in the network iNumber = 50 ' Retrieve the Sections collection Dim cSections As Sections Set cSections = CATIA.ActiveDocument.Product.GetTechnologicalObject("Sections")
' Create the master section Dim oMasterSection As Object Set oMasterSection = cSections.Add
' Retrieve data on master section Dim Position(11) oMasterSection.GetPosition Position Dim dHeight As Double dHeight = oMasterSection.Height Dim dWidth As Double dWidth = oMasterSection.Width Dim dMin As Double If (dWidth > dHeight) Then dMin = dWeight Else dMin = dWidth End If ' Remove the master section cSections.Remove oMasterSection Set oMasterSection = Nothing ' Create the network Dim oSection As Object Position(11) = Position(11) - dMin / 2 Dim i As Integer For i = 1 To iNumber ' Create section and force type Set oSection = cSections.Add oSection.Type = catSectionTypePlane ' Modify position Position(11) = Position(11) + dMin / iNumber oSection.SetPosition Position Set oSection = Nothing Next Set cSections = Nothing End Sub
Mir gelingt es nicht diese zusammen zu führen, kannst du bitte unterstützen wie ich Parts in einem Product ansprechen kann. Welche Literatur würdest du empfehlen? Die CATIA Syntax ist für mich neu und mir fehlt ein Werk zum nachschlagen.
Viele Grüße Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 24. Aug. 2020 22:15 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Literatur (Catia spezifisch): schau mal auf catia.cad.de Zusätzlich sind Grundlagen zu VB bzw VBA sinnvoll/erforderlich. Brauchst du wirklich die Schnitte im CATProduct? Das macht das ganze komplexer. Würde auch ein Intersect aus dem GSD reichen? Falls es im Product eine Section sein soll, folgende Idee: - im Product auf die Ebenen zugreifen
- per Messung (GetPlane) die Ebene messen
- den Array beim anlegen einer Section nutzen (SetPosition)
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 25. Aug. 2020 10:09 <-- editieren / zitieren --> Unities abgeben:
Hallo, ich habe die Intersect aus dem GSD benutzt, das Ergebnis ist brauchbar. Allerdings muss ich jede einzelne Intersection (Die Kontur als Linienzug) als .stp File abspeichern, da die Ergebnisse im Anschluss von einem Machine Learning Tool ausgelesen werden. Siehst du eine Möglichkeit wie nur die Intersec als .stp-File abgespeichert werden kann? Im Product ist dies unter Sections möglich. Beim GSD + Intersect habe ich keinen Ansatz dafür gefunden. Gruß, Sebastian Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 25. Aug. 2020 10:37 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Zitat: Siehst du eine Möglichkeit wie nur die Intersec als .stp-File abgespeichert werden kann?
zB: - alles andere ausblenden und dann exportieren
- oder die Verschneidung als Ergebnis in ein temporäres Part kopieren und dieses dann exportieren
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 26. Aug. 2020 10:00 <-- editieren / zitieren --> Unities abgeben:
Hallo Bernd, mit folgendem Script, werden jetzt im Part automatisch GeoSets erstellt für die Planes und die Intersections. In der Schleife möchte ich unter Punkt 3 die jeweilige Intersection in ein neues Part kopieren, um dieses dann wiederum in Punkt 4. als STEP zu exportieren. Hierbei komme ich noch nicht weiter, kannst du mir mit Hilfe von Code bitte ein Denkanstoß oder ein ähnliches Beispiel geben? Im Forum habe ich noch nichts passendes gefunden. LG, Sebastian Sub CATMain() 'Variablen festlegen f?r Ebenen Dim oPartDocument As Document Dim oPart As Part Dim oHybridBodies As HybridBodies Dim oHybridBody As HybridBody Dim oHybridShapes As HybridShapes Dim oSpline As HybridShape Dim ohybridBodyPlanes As HybridBody Dim oHybridShapeFactory As Factory Dim oPointOnCurve As HybridShapePointOnCurve Dim refSpline As Reference Dim i As Integer Dim iPlanesCount As Integer Dim refPoint As Reference Dim oPlaneNormal As HybridShapePlaneNormal Dim dSpacing As Double 'Variablen festlegen f?r Intersections Dim reference1 As Reference Dim reference2 As Reference Dim bodies1 As Bodies Dim body1 As Body Dim hybridShapeFactory1 As HybridShapeFactory Dim oHybridIntersections As HybridBody 'Werte festlegen iPlanesCount = 50 'Anzahl der Ebenen/Punkte dSpacing = 50 'Abstand in mm 'Vorbereitungen f?r Ebenen Set oPartDocument = CATIA.ActiveDocument Set oPart = oPartDocument.Part Set oHybridBodies = oPart.HybridBodies Set oHybridBody = oHybridBodies.Item("Geometrisches Set.1") Set oHybridShapes = oHybridBody.HybridShapes Set oSpline = oHybridShapes.Item("Circle.1") Set oHybridShapeFactory = oPart.HybridShapeFactory Set refSpline = oPart.CreateReferenceFromObject(oSpline) Set ohybridBodyPlanes = oHybridBodies.Add() ohybridBodyPlanes.Name = "Planes"
'Vorbvereitungen f?r Intersections Set bodies1 = oPart.Bodies Set body1 = bodies1.Item("D533 70038 204 00") Set hybridShapeFactory1 = oPart.HybridShapeFactory Set oHybridIntersections = oHybridBodies.Add() oHybridIntersections.Name = "Intersections" 'Punkte/Ebenen/Intersections/STEP-Files Speichern erzeugen For i = 1 To iPlanesCount '1. Ebene erzeugen Set oPointOnCurve = oHybridShapeFactory.AddNewPointOnCurveFromDistance(refSpline, dSpacing * i, False) oPointOnCurve.DistanceType = 1 ohybridBodyPlanes.AppendHybridShape oPointOnCurve Set refPoint = oPart.CreateReferenceFromObject(oPointOnCurve) Set oPlaneNormal = oHybridShapeFactory.AddNewPlaneNormal(refSpline, refPoint) ohybridBodyPlanes.AppendHybridShape oPlaneNormal '2. Intersection erzeugen Set reference1 = oPart.CreateReferenceFromObject(oPlaneNormal) Set reference2 = oPart.CreateReferenceFromObject(body1) Dim hybridShapeIntersection1 As HybridShapeIntersection Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2) hybridShapeIntersection1.PointType = 0 Dim hybridBody2 As HybridBody Set hybridBody2 = oHybridBodies.Item("Intersections") hybridBody2.AppendHybridShape hybridShapeIntersection1 oPart.InWorkObject = hybridShapeIntersection1 '3. Intersection in ein neues Part speichern mit selbiger Bezeichnung '4. Intersection als STEP abspeichern '______________ oPart.Update Next
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 26. Aug. 2020 11:54 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Hast du schon mal per Makroaufzeichnung, Doku und Forensuche probiert deine fehlenden Teilschritte zu lösen/anzugehen?. Ich geb dir mal ein paar Stichpunkte: - Kopieren: Selection, Copy, PasteSpecial
- Step-Export: ExportData
Bei konkreten Problemen kannst du dich gerne wieder melden. Gruß Bernd PS: bitte Code in entsprechenden Tags posten ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 26. Aug. 2020 21:03 <-- editieren / zitieren --> Unities abgeben:
Hallo Bernd, nun erstellt das Makro erfolgreich ein neues Bauteil, ich habe den Makrorecorder benutzt um Teilschritte nach zu vollziehen. Beim Paste Special passiert bei meinem aktuellen Code jedoch nichts. Hier wäre eine Hilfestellung deinerseits klasse, bitte schau mal ob mein Ansatz sinnvoll ist, ich kopiere die Intersection, aktiviere dann das neue Part und möchte es dann per Pase Special einfügen, den Fileexport bekomme ich dann denke ich mittels vorhandenem Code aus der Community hin. Gruß, Sebastian Sub CATMain()
'Variablen festlegen f?r Ebenen Dim oPartDocument As Document Dim oPart As Part Dim oHybridBodies As HybridBodies Dim oHybridBody As HybridBody Dim oHybridShapes As HybridShapes Dim oSpline As HybridShape Dim ohybridBodyPlanes As HybridBody Dim oHybridShapeFactory As Factory Dim oPointOnCurve As HybridShapePointOnCurve Dim refSpline As Reference Dim i As Integer Dim iPlanesCount As Integer Dim refPoint As Reference Dim oPlaneNormal As HybridShapePlaneNormal Dim dSpacing As Double 'Variablen festlegen f?r Intersections Dim reference1 As Reference Dim reference2 As Reference Dim bodies1 As Bodies Dim body1 As Body Dim hybridShapeFactory1 As HybridShapeFactory Dim oHybridIntersections As HybridBody 'Werte festlegen iPlanesCount = 2 'Anzahl der Ebenen/Punkte dSpacing = 50 'Abstand in mm 'Vorbereitungen f?r Ebenen Set oPartDocument = CATIA.ActiveDocument Set oPart = oPartDocument.Part Set oHybridBodies = oPart.HybridBodies Set oHybridBody = oHybridBodies.Item("Geometrisches Set.1") Set oHybridShapes = oHybridBody.HybridShapes Set oSpline = oHybridShapes.Item("Circle.1") Set oHybridShapeFactory = oPart.HybridShapeFactory Set refSpline = oPart.CreateReferenceFromObject(oSpline) Set ohybridBodyPlanes = oHybridBodies.Add() ohybridBodyPlanes.Name = "Planes"
'Vorbvereitungen f?r Intersections Set bodies1 = oPart.Bodies Set body1 = bodies1.Item("D533 70038 204 00") Set hybridShapeFactory1 = oPart.HybridShapeFactory Set oHybridIntersections = oHybridBodies.Add() oHybridIntersections.Name = "Intersections" 'Punkte/Ebenen/Intersections/STEP-Files Speichern erzeugen For i = 1 To iPlanesCount '1. Ebene erzeugen Set oPointOnCurve = oHybridShapeFactory.AddNewPointOnCurveFromDistance(refSpline, dSpacing * i, False) oPointOnCurve.DistanceType = 1 ohybridBodyPlanes.AppendHybridShape oPointOnCurve Set refPoint = oPart.CreateReferenceFromObject(oPointOnCurve) Set oPlaneNormal = oHybridShapeFactory.AddNewPlaneNormal(refSpline, refPoint) ohybridBodyPlanes.AppendHybridShape oPlaneNormal '2. Intersection erzeugen Set reference1 = oPart.CreateReferenceFromObject(oPlaneNormal) Set reference2 = oPart.CreateReferenceFromObject(body1) Dim hybridShapeIntersection1 As HybridShapeIntersection Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2) hybridShapeIntersection1.PointType = 0 Dim hybridBody2 As HybridBody Set hybridBody2 = oHybridBodies.Item("Intersections") hybridBody2.AppendHybridShape hybridShapeIntersection1 oPart.InWorkObject = hybridShapeIntersection1 '3. Intersection in ein neues Part speichern mit selbiger Bezeichnung Dim documents1 As Documents Dim oCopyPart As PartDocument Dim oCopyObject As Selection Set documents1 = CATIA.Documents Set oCopyPart = documents1.Add("Part") Set oCopyObject = oPartDocument.Selection oCopyObject.Add hybridShapeIntersection1 oCopyObject.Copy Set oCopyPart = CATIA.ActiveDocument 'Wechsel zum neuen Part oCopyObject.PasteSpecial "CATPrtResultWithOutLink" oCopyObject.Clear oCopyPart.Part.Update '4. Intersection als STEP abspeichern 'Dim partDocument1 As Document 'Set partDocument1 = CATIA.ActiveDocument 'DocName = partDocument1.Name 'DocPath = partDocument1.Path 'StpPath = DocPath & "\" & Left(DocName, Len(DocName) - 8) 'On Error Resume Next 'partDocument1.ExportData StpPath, "stp" 'partDocument1.ExportData StpPath, "3dxml" '______________ oPart.Update Next
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 26. Aug. 2020 21:18 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Sieht doch schon vielversprechend aus. Selektiere vor dem einfügen im neuen Part mal ein GeoSet. Beispiel: Code:
oCopyObject.Add hybridShapeIntersection1 oCopyObject.CopyDim oTargetSelection as Selection Set oTargetDocument = documents1.Add("Part") Set oTargetSelection = oTargetDocument.Selection oTargetSelection.Add oTargetDocument.Part.HybridBodies.Item(1) oTargetSelection.PasteSpecial "CATPrtResultWithOutLink" oTargetDocument.Part.Update
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
slueck Mitglied ING
Beiträge: 11 Registriert: 21.08.2020
|
erstellt am: 27. Aug. 2020 21:37 <-- editieren / zitieren --> Unities abgeben:
Hallo Bernd, erstmal vielen Dank für deine Unterstützung, das ist einfach klasse was du machst. Mein Programm ist so gut wie fertig, die Funktion Makro Aufzeichnen sowie das Forum haben mir gut geholfen. Eine Sache fehlt mir noch. Ich will das Part "Bereinigen" bevor die einzelnen Anweisungen ausgeführt werden. Heisst die Geosets die ich erstellen möchte "Planes" "Intersections" "Intersections1" sollen beim Programmstart gelöscht werden, sofern vorhanden. Somit will ich verhindern, dass bei mehrfacher Programmausführung eine enorme Anhäufung von Geosets mit selbigen Namen existiert. Hier mein Ansatz: LG, Sebastian Code: 'Geosets vorbereitenIf CATIA.ActiveDocument.Selection.Count > 1 Then CATIA.ActiveDocumnet.Selection ("Planes") Selection.Delete End If
hier der gesamte Code:
Code:
Sub CATMain()'to do 'GeoSets beim Start l?schen 'Variablen festlegen f?r Ebenen Dim oPartDocument As Document Dim oPart As Part Dim oHybridBodies As HybridBodies Dim oHybridBody As HybridBody Dim oHybridShapes As HybridShapes Dim oSpline As HybridShape Dim ohybridBodyPlanes As HybridBody Dim oHybridShapeFactory As Factory Dim oPointOnCurve As HybridShapePointOnCurve Dim refSpline As Reference Dim i As Integer Dim iPlanesCount As Integer Dim refPoint As Reference Dim oPlaneNormal As HybridShapePlaneNormal Dim dSpacing As Double
'Variablen festlegen f?r Intersections Dim reference1 As Reference Dim reference2 As Reference Dim bodies1 As Bodies Dim body1 As Body Dim hybridShapeFactory1 As HybridShapeFactory Dim oHybridIntersections As HybridBody Dim oHybridIntersections2 As HybridBody 'Geosets vorbereiten
If CATIA.ActiveDocument.Selection.Count > 1 Then CATIA.ActiveDocumnet.Selection ("Planes") Selection.Delete End If 'Werte festlegen iPlanesCount = 3 'Anzahl der Ebenen/Punkte dSpacing = 50 'Abstand in mm 'Vorbereitungen f?r Ebenen Set oPartDocument = CATIA.ActiveDocument Set oPart = oPartDocument.Part Set oHybridBodies = oPart.HybridBodies Set oHybridBody = oHybridBodies.Item("Geometrisches Set.1") Set oHybridShapes = oHybridBody.HybridShapes Set oSpline = oHybridShapes.Item("Circle.1") Set oHybridShapeFactory = oPart.HybridShapeFactory Set refSpline = oPart.CreateReferenceFromObject(oSpline) Set ohybridBodyPlanes = oHybridBodies.Add() ohybridBodyPlanes.Name = "Planes"
'Vorbvereitungen f?r Intersections Set bodies1 = oPart.Bodies Set body1 = bodies1.Item("D533 70038 204 00") Set hybridShapeFactory1 = oPart.HybridShapeFactory Set oHybridIntersections = oHybridBodies.Add() oHybridIntersections.Name = "Intersections" Set oHybridIntersections2 = oHybridBodies.Add() oHybridIntersections2.Name = "Intersections2" 'Speicherort f?r Intersections abfragen Const WINDOW_HANDLE = 0 Const NO_OPTIONS = 0 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder _ (WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, "C:\Scripts") Set objFolderItem = objFolder.Self objPath = objFolderItem.Path objPath = Replace(objPath, "\", "\\") strComputer = "." Set objWMIService = GetObject _ ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") Set colFiles = objWMIService.ExecQuery _ ("SELECT * FROM Win32_Directory WHERE Name = '" & objPath & "'") 'For Each objFile In colFiles 'Wscript.Echo "Readable: " & objFile.Readable 'Next 'Punkte/Ebenen/Intersections/STEP-Files Speichern erzeugen For i = 1 To iPlanesCount '1. Ebene erzeugen Set oPointOnCurve = oHybridShapeFactory.AddNewPointOnCurveFromDistance(refSpline, dSpacing * i, False) oPointOnCurve.DistanceType = 1 ohybridBodyPlanes.AppendHybridShape oPointOnCurve Set refPoint = oPart.CreateReferenceFromObject(oPointOnCurve) Set oPlaneNormal = oHybridShapeFactory.AddNewPlaneNormal(refSpline, refPoint) ohybridBodyPlanes.AppendHybridShape oPlaneNormal '2. Intersection erzeugen Set reference1 = oPart.CreateReferenceFromObject(oPlaneNormal) Set reference2 = oPart.CreateReferenceFromObject(body1) Dim hybridShapeIntersection1 As HybridShapeIntersection Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(reference1, reference2) Dim hybridShapeIntersection2 As HybridShapeIntersection Set hybridShapeIntersection2 = hybridShapeFactory1.AddNewIntersection(reference1, reference2) hybridShapeIntersection1.PointType = 0 hybridShapeIntersection2.PointType = 0 Dim hybridBody2 As HybridBody Set hybridBody2 = oHybridBodies.Item("Intersections") Dim hybridBody3 As HybridBody Set hybridBody3 = oHybridBodies.Item("Intersections2") hybridBody2.AppendHybridShape hybridShapeIntersection1 hybridBody3.AppendHybridShape hybridShapeIntersection2 oPart.InWorkObject = hybridShapeIntersection1 oPart.Update '3. Intersection in ein neues Part speichern mit selbiger Bezeichnung Dim DocName As String DocName = i Dim documents1 As Documents Dim oCopyObject As Selection Set documents1 = CATIA.Documents Set oCopyObject = oPartDocument.Selection oCopyObject.Add hybridShapeIntersection1 oCopyObject.Copy Dim oTargetSelection As Selection Set oTargetDocument = documents1.Add("Part") 'erstellen neues Part Dim oTargetDocument1 As PartDocument 'umbennen neues Part Set oTargetDocument1 = CATIA.ActiveDocument Dim product1 As Product Set product1 = oTargetDocument1.GetItem("Part2") product1.PartNumber = DocName Set oTargetSelection = oTargetDocument.Selection oTargetSelection.Add oTargetDocument.Part.HybridBodies.Item(1) oTargetSelection.PasteSpecial "CATPrtResultWithOutLink" oTargetDocument.Part.Update oCopyObject.Delete '4. Intersection als STEP abspeichern DocPath = objPath 'oPartDocument.Path StpPath = DocPath & "Intersection_" & DocName On Error Resume Next oTargetDocument.ExportData StpPath, "stp" CATIA.ActiveDocument.Close 'CATIA.FileSystem.DeleteFile (FullName & ".stp") Next MsgBox "Program Completed!" End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Konstrukteur (w/m/d) | Formel D ist der globale Dienstleister der Automobilindustrie. Wir entwickeln marktführende Konzepte sowie individuelle, skalierbare Lösungen entlang der kompletten automobilen Wertschöpfungskette ? von der Entwicklung über die Produktion bis hin zum Aftersales. Formel D wurde 1993 gegründet, der Hauptsitz der Unternehmensgruppe befindet sich in der Millionenmetropole Köln. In unseren interkulturellen Teams arbeiten heute weltweit mehr als 10.... | Anzeige ansehen | Konstruktion, Visualisierung |
|
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 27. Aug. 2020 22:11 <-- editieren / zitieren --> Unities abgeben: Nur für slueck
Servus Kleines Beispiel mit der Suche (per Makrorekorder erfasst) Code: Dim partDocument1 As Document Set partDocument1 = CATIA.ActiveDocumentDim selection1 As Selection Set selection1 = partDocument1.Selection selection1.Clear selection1.Search "(CATGmoSearch.OpenBodyFeature.Name=Planes + CATGmoSearch.OpenBodyFeature.Name=Intersections + CATGmoSearch.OpenBodyFeature.Name=Intersections2),all" selection1.Delete
Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |