Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  Makro Bauteil schneiden

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Makro Bauteil schneiden (1434 mal gelesen)
slueck
Mitglied
ING


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 21. Aug. 2020 23:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


D533_70038_204_00.CATPart

 
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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 21. Aug. 2020 23:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 22. Aug. 2020 07:25    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 22. Aug. 2020 15:27    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Bild1.PNG

 
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


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 22. Aug. 2020 15:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 22. Aug. 2020 16:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 24. Aug. 2020 21:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 24. Aug. 2020 22:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 25. Aug. 2020 10:09    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Intersection.PNG

 
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


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 25. Aug. 2020 10:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 26. Aug. 2020 10:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 26. Aug. 2020 11:54    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 26. Aug. 2020 21:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 26. Aug. 2020 21:18    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

Servus

Sieht doch schon vielversprechend aus.
Selektiere vor dem einfügen im neuen Part mal ein GeoSet.
Beispiel:

Code:

oCopyObject.Add hybridShapeIntersection1
oCopyObject.Copy

Dim 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


Sehen Sie sich das Profil von slueck an!   Senden Sie eine Private Message an slueck  Schreiben Sie einen Gästebucheintrag für slueck

Beiträge: 11
Registriert: 21.08.2020

erstellt am: 27. Aug. 2020 21:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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 vorbereiten

If 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

bgrittmann
Moderator
Konstrukteur


Sehen Sie sich das Profil von bgrittmann an!   Senden Sie eine Private Message an bgrittmann  Schreiben Sie einen Gästebucheintrag für bgrittmann

Beiträge: 11780
Registriert: 30.11.2006

CATIA V5R19

erstellt am: 27. Aug. 2020 22:11    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für slueck 10 Unities + Antwort hilfreich

Servus

Kleines Beispiel mit der Suche (per Makrorekorder erfasst)

Code:
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim 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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz