Autor
|
Thema: Rechteckmuster Richtung ermitteln (1151 mal gelesen)
|
Estafanos Mitglied
Beiträge: 27 Registriert: 17.07.2012 Catia V5 R22, Windows 7
|
erstellt am: 21. Feb. 2017 14:37 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, leider komme ich mit einem Punkt nicht weiter. Es wird gerade ein Makro programmiert das ein Rechteckmuster (RectangularPattern) aus dem PartDesign ins GSD (Generative Shape Design) übertragen soll um dort ein anderes Objekt z. B. Fläche damit zu Mustern. Mit Kreismuster und Benutzerdefinierten Mustern klappt es schon. Beim Rechteckmuster ist das Problem wie kann man die 1. und 2. Direction auslesen (objPattern) und ins GSD (MyNeurectPattern) übertragen. Direction können auch Kanten sein. Vielen Dank für eure Unterstützung. Gruß Estafanos [CODE][/CODE] Sub CATRectPattern() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument Dim part1 As Part Set part1 = partDocument1.Part Dim shapeFactory1 As ShapeFactory Set shapeFactory1 = part1.ShapeFactory Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Dim hybridBody1 As HybridBody Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1") Dim hybridShapes1 As HybridShapes Set hybridShapes1 = hybridBody1.HybridShapes hybridShapeCylinder1_Name = "Flaeche_1" 'Set iShapeToCopy = hybridShapes1.Item(hybridShapeCylinder1_Name)
'Muster RectPattern----------------------------------------------- Dim objSel As Selection Set objPartDoc = CATIA.ActiveDocument Set objSel = objPartDoc.Selection objSel.Clear objSel.Search "CATPrtSearch.RectPattern,all" If objSel.Count > 0 Then For i = 1 To objSel.Count Set objPattern = objSel.Item(i).Value objPattern.Name = "Muster von " & objSel.Item(i).Value.ItemToCopy.Name Next End If Rem Hier handelt sich um Mustern entlang eine Richtung oder zwei Richtungen Rem Property Index Rem (Done) FirstDirectionRepartition: Returns the linear repartition along the first direction. Rem FirstDirectionRow: Returns the position of the shape to be copied along the first linear direction. Rem (Done) FirstOrientation: Returns or sets whether the pattern is built towards the first direction orientation. Rem FirstRectangularPatternParameters: Returns or sets the rectangular pattern parameters required to define the pattern. Rem (Done) SecondDirectionRepartition: Returns the linear repartition along the second direction. Rem SecondDirectionRow: Returns the position of the shape to be copied along the second linear direction. Rem (Done) SecondOrientation:Returns or sets whether the pattern is built towards the second direction orientation. Rem SecondRectangularPatternParameters:Returns or sets the rectangular pattern parameters required to define the pattern. objPatternFirstRectangularPatternParameters = objPattern.FirstRectangularPatternParameters objPatternSecondRectangularPatternParameters = objPattern.SecondRectangularPatternParameters Rem Method Index Rem GetFirstDirection: Returns the first repartition direction. Dim FirstDir(2) As Variant objPattern.GetFirstDirection (FirstDir) XFirstDir = FirstDir(0) YFirstDir = FirstDir(1) ZFirstDir = FirstDir(2)
Rem GetSecondDirection: Returns the second repartition direction. ' Funktioniert nicht bei Plan Dim SecondDir(2) objPattern.GetSecondDirection (SecondDir) xSecondDir = SecondDir(0) ySecondDir = SecondDir(1) zSecondDir = SecondDir(2) Instance_objPattern_FirstDirektion = objPattern.FirstDirectionRepartition.InstancesCount.Value Instance_objPattern_SecendDirektion = objPattern.SecondDirectionRepartition.InstancesCount.Value Spacing_objPattern_FirstDirektion = objPattern.FirstDirectionRepartition.Spacing.Value Spacing_objPattern_SecendDirektion = objPattern.SecondDirectionRepartition.Spacing.Value objPattern_FirstOrientation = objPattern.FirstOrientation objPattern_SecondOrientation = objPattern.SecondOrientation objPattern_FirstDirectionRow = objPattern.FirstDirectionRow.Name Rem SetFirstDirection: Sets the first repartition direction. aligned1 = objPattern.FirstOrientation Rem SetInstanceSpacing: Sets the InstanceSpacing. Rem SetSecondDirection: Sets the second repartition direction. Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromName("") Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromName("") Dim MyNeurectPattern As RectPattern Rem Set MyNeurectPattern = shapeFactory1.AddNewSurfacicRectPattern(iShapeToCopy, 2, 1, 20#, 20#, 1, 1, reference1, reference2, True, True, 0#) MyNeurectPattern.FirstRectangularPatternParameters = objPatternFirstRectangularPatternParameters MyNeurectPattern.SecondRectangularPatternParameters = objPatternSecondRectangularPatternParameters MyNeurectPattern.SetFirstDirection refToLine1 hybridBody1.AppendHybridShape MyNeurectPattern part1.Update End Sub Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Moderator 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: 21. Feb. 2017 15:32 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Hi Estefanos, willst Du ein neues Pattern anlegen und dazu die Richtungen bestimmen? Oder ein vorhandenes Pattern analysieren? Ausserdem: So wie die Schleife aufgebaut ist, bearbeitest Du stets nur das letzte 'objPattern' im weiteren Programmverlauf. Ist das so gewollt? Tschau, Joe PS: Der Code kommt zwischen die [CODE]-Tags :-) ------------------ Inoffizielle Catia Hilfeseite Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Moderator 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: 21. Feb. 2017 16:52 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Hi Estefanos, ich hab noch ein bisschen mit dem Pattern gespielt. Ich behaupte, die Zeile
Code: objPattern.GetFirstDirection (FirstDir)
liefert für 'FirstDir' nix, sprich ein leeres Array zurück. Probier mal stattdessen
Code: objPattern.GetFirstDirection FirstDir
oder Code:
'________VBA-Modul________ Sub catmain2() Dim oAD As PartDocument Dim oADP As Part Dim arrDir1(2) ' As Variant Dim arrDir2(2) Dim objPattern As Object 'RectPattern Dim oDirInst1 Dim oDirInst2 Dim oDirSpc1 Dim oDirSpc2 Dim oDirOrient1 Dim oDirOrient2 Set oAD = CATIA.ActiveDocument Set oADP = oAD.Part Set objPattern = oADP.FindObjectByName("RectPattern.1") If TypeName(objPattern) <> "Nothing" Then objPattern.GetFirstDirection arrDir1 Debug.Print arrDir1(0), arrDir1(1), arrDir1(2) objPattern.GetSecondDirection arrDir2 Debug.Print arrDir2(0), arrDir2(1), arrDir2(2) oDirInst1 = objPattern.FirstDirectionRepartition.InstancesCount.Value oDirInst2 = objPattern.SecondDirectionRepartition.InstancesCount.Value Debug.Print oDirInst1, oDirInst2 oDirSpc1 = objPattern.FirstDirectionRepartition.Spacing.Value oDirSpc2 = objPattern.SecondDirectionRepartition.Spacing.Value Debug.Print oDirSpc1, oDirSpc2 oDirOrient1 = objPattern.FirstOrientation oDirOrient2 = objPattern.SecondOrientation Debug.Print oDirOrient1, oDirOrient2 End If End Sub
wobei das RectPattern mit Namen 'RectPattern.1' existieren muss. Typischer Output: ------------------------------------------------ -1 -3.83999874084854E-17 0 0 1 0 9 4 20 -20 True True ------------------------------------------------ Tschau, Joe ------------------ Inoffizielle Catia Hilfeseite 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: 21. Feb. 2017 17:30 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Servus Vermutlich ist das Kernproblem dabei, dass man bei einem bestehenden Pattern die Richtung nur als Vektor auslesen kann, aber bei neu anlegen eines Pattern (oder ändern der Richtung) eine Reference übergeben muss. ggf geht es über (ungetestet): aus dem Vektor über AddNewDirectionByCoord eine Direction erzeugen und aus dieser dann eine Refernce bilden (CreateReferenceByObject) Gruß Bernd
------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Estafanos Mitglied
Beiträge: 27 Registriert: 17.07.2012 Catia V5 R22, Windows 7
|
erstellt am: 21. Feb. 2017 23:12 <-- editieren / zitieren --> Unities abgeben:
Hallo Joe, hallo Bernd, lieben Dank für die Hinweise und die rasche Antwort. Anstatt "objPattern.GetFirstDirection (FirstDir)" wurde "objPattern.GetFirstDirection FirstDir" deklariert, dann hat es sehr gut funktioniert. Es hat auch sehr gut mit der Vektor-Erzeugung (AddNewDirectionByCoord) und danach als Reference über „CreateReferenceByObject“ funktioniert. Jetzt habe ich ein weiteres Problem, wie Joe geschrieben hat, dass nur das letzte Muster genommen wird. Ich habe z. B. Muster und als „ItemToCopy“ ein Bohrung-Objekt. Die Input-Werte von diesem Muster (Bohrungen) sollen eingelesen werden, damit ein neues Muster (im GSD) mit bestimmten Flächen erzeugt wird. Es gibt viele Bauteile, die ich bereuen soll. In diesen Bauteilen gibt es viele Mustern und viele Bohrungen, die in alle X-, Y- und Z-Richtungen verteilt sind. Könntet ihr mir bitte helfen? Viele Grüße Estafanos
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: 21. Feb. 2017 23:37 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Servus Du musst doch nur das Ende der For-Next-Schleife ganz ans Ende setzen, dann werden alle gefundenen Muster abgearbeitet. Gruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Moderator 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: 22. Feb. 2017 00:13 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Zitat:
Jetzt habe ich ein weiteres Problem, dass nur das letzte Muster genommen wird.
Wenn Du alle Teile analysieren willst, musst die Schleife entsprechend erweitern. Zitat:
Es gibt viele Bauteile, die ich bereuen soll.
Ich kenne viele Konstrukteure, aber keinen, der seine Bauteile bereut(obwohl sie's müssten)! :-) Tschau, Joe ------------------ Inoffizielle Catia Hilfeseite Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Estafanos Mitglied
Beiträge: 27 Registriert: 17.07.2012 Catia V5 R22, Windows 7
|
erstellt am: 22. Feb. 2017 17:25 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, jetzt stoße ich auf ein weiteres Problem. Das Ursprungsgewinde wurde mit der Funktion "Thread" separat erzeugt, das ich lesen muss und als Fläche erstellen soll. Das Zukünftige Gewinde soll als Fläche in einem Geometrical Set erzeugt werden. Die Funktion "Thread" hat folgende Parameter oder Referenzen: - Lateral Face - Limit Face - Diameter (das kann ich lesen) - Depth (das kann ich lesen) - Pitch (das kann ich lesen) Wie kann man "Lateral Face" und "Limit Face" aus einem vorhandenen Gewinde als Vektor/Linie und Ebene erstellen, damit ich die neue Fläche erzeugen kann? Vielen Dank für eure Hilfe. Gruß Estafanos [CODE][/CODE] Dim objSel As Selection Dim objPartDoc 'As PartDocument 'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant Dim i As Integer Set objPartDoc = CATIA.ActiveDocument Set objSel = objPartDoc.Selection Set selection1 = CATIA.ActiveDocument.Selection Set visPropertySet1 = selection1.VisProperties 'Außengewinde objSel.Clear objSel.Search "CATPrtSearch.Thread,all" If objSel.Count > 0 Then For i = 1 To objSel.Count Set objHoleThread = objSel.Item(i).Value Dim objHoleThreadType As String Ende_Gewinde_LimitFaceElement = objHoleThread.LimitFaceElement.Name objHoleThread_Name = objHoleThread.Name ' Name objHoleThread_Diameter = objHoleThread.Diameter 'Durchmesser objHoleThread_Pitch = objHoleThread.Pitch 'Steigung objHoleThread_Depth = objHoleThread.Depth 'Tiefe Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces") Set sketch1 = objHole.Sketch Set originElements1 = part1.OriginElements Dim coordArrayThreadThread(2) objHoleThread.GetOrigin coordArrayThread XcoordArrayThread = coordArrayThread(0) YcoordArrayThread = coordArrayThread(1) ZcoordArrayThread = coordArrayThread(2) Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(XcoordArrayThread, YcoordArrayThread, ZcoordArrayThread) Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces") hybridBody1.AppendHybridShape hybridShapePointCoord1 part1.InWorkObject = hybridShapePointCoord1 part1.Update Dim dirArrayThread(2) objHole.GetDirection dirArrayThread XdirArrayThread = dirArrayThread(0) YdirArrayThread = dirArrayThread(1) ZdirArrayThread = dirArrayThread(2) 'create explicit direction Set objHoleDirection = hybridShapeFactory1.AddNewDirectionByCoord(XdirArrayThread, YdirArrayThread, ZdirArrayThread) Dim refHoleDirectionThread As Reference Set refHoleDirectionThread = part1.CreateReferenceFromObject(objHoleDirection) hybridBody1.AppendHybridShape objHoleDirection part1.Update Dim reference1Thread As Reference Set reference1Thread = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeCylinder1Thread As HybridShapeCylinder Set hybridShapeCylinder1Thread = hybridShapeFactory1.AddNewCylinder(reference1Thread, Durchmesser_Gewinde / 2, Gewinde_Tiefe, 0#, objHoleDirection) hybridShapeCylinder1Thread.Orientation = False hybridBody1.AppendHybridShape hybridShapeCylinder1Thread part1.InWorkObject = hybridShapeCylinder1Thread hybridShapeCylinder1Thread_Name = objHole.Name hybridShapeCylinder1Thread.Name = "Surface_" & hybridShapeCylinder1_Name part1.Update Next End If
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. Feb. 2017 17:49 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Servus Der Code sollt immer noch innerhalb der Code-Tags gepostet werden *grins* ggf kannst du mit der Messfunktion (SPA-Workbench) aus den beiden Elementen (Reference) was auslesen (GetAxis, GetPointsOnAxis , GetPlain). Was soll den das ganze werden wenn es fertig ist? Gruß Bernd
------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
joehz Moderator 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: 22. Feb. 2017 19:49 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Hi Estefanos, kurz zu Deinem letzten Makro:
Code:
Dim objSel As Selection Dim objPartDoc 'As PartDocument 'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant
Der Default-Typ für Variable ist 'Variant'. Deshalb kannst statt Code: Dim objThickness As Variant
genausogut Code: Dim objThickness
schreiben. Eine Anweisung Code:
Dim i, j, n as integer
weist nicht 'i' und 'j' den Typ 'Integer zu; lediglich 'n' bekommt den Typ zugeweisen. Ausserdem: 'Dim'-Zuweisungen haben innerhalb einer Schleife nix verloren; generell nicht, ohne Ausnahmen. Tschau, Joe ------------------ Inoffizielle Catia Hilfeseite Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Estafanos Mitglied
Beiträge: 27 Registriert: 17.07.2012 Catia V5 R22, Windows 7
|
erstellt am: 24. Feb. 2017 10:31 <-- editieren / zitieren --> Unities abgeben:
Hallo Zusammen, Die Anwender verwenden für die Gewindedarstellung im 3D-Modell die Funktion „Thread/Tap“ (Part Design). Aus der „Thread/Tap“ soll eine Fläche in einem „Geometrical Set“ erzeugt werden. Aus der Funktion „Thread/Tap“ kann ich folgende Informationen lesen (im Code): - Name - Durchmesser - Steigung - Tiefe Aus „Lateral Face“ und „Limit Face“ sollen die Richtung und der Mittelpunkt des Gewindes erstellt werden, damit die gewünschte Fläche abgeleitet werden kann. 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 Set ohyBody = hybridBodies1.Add() ohyBody.Name = "Theard_Surfaces" part1.InWorkObject = ohyBody part1.Update Dim objSel As Selection Dim objPartDoc 'As PartDocument 'Dim objHole, objPattern, objChamfer, objFillet, objThread, objThickness As Variant Dim objHole, objChamfer, objFillet, objThread, objThickness As Variant Dim i As Integer Set objPartDoc = CATIA.ActiveDocument Set objSel = objPartDoc.Selection Set selection1 = CATIA.ActiveDocument.Selection Set visPropertySet1 = selection1.VisProperties 'Außengewinde----------------------------------------------- objSel.Clear objSel.Search "CATPrtSearch.Thread,all" If objSel.Count > 0 Then For i = 1 To objSel.Count Set objHoleThread = objSel.Item(i).Value Dim objHoleThreadType As String Ende_Gewinde_LimitFaceElement = objHoleThread.LimitFaceElement.Name 'LimitFaceElement objHoleThread_Name = objHoleThread.Name 'Thread.Name objHoleThread_Diameter = objHoleThread.Diameter ' Durchmesser objHoleThread_Pitch = objHoleThread.Pitch 'Steigung objHoleThread_Depth = objHoleThread.Depth ' Tiefe Set HoleThreadDescription = objHoleThread.ThreadDescription 'ThreadDescription 'Set Ursprungspunkt_Gewinde = objHole.Sketch.GeometricElements.Item(2) objHoleThread_NameLFaceElement = objHoleThread.LimitFaceElement.DisplayName 'LimitFaceElement.DisplayName objHoleThread_NameLateralFaceElement = objHoleThread.LateralFaceElement.DisplayName 'LateralFaceElement.DisplayName oName = objHoleThread.Parent.Parent.Name Dim objHoleThread_NameLateralFaceElement1 As String objHoleThread_NameLateralFaceElement1 = objHoleThread_NameLFaceElement Dim objHoleThread_NameLimitFaceElement1 As String objHoleThread_NameLimitFaceElement1 = objHoleThread_NameLateralFaceElement 'Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces") oName2 = objHoleThread.Parent.Name ' Heir sollen aus LimitFaceElement und LateralFaceElement die Richtung, Ebene und Punkt (Mittelpunkt vom Gewinde)in einem Geoterical set erzeugt werden. ' als Beispiel: AddNewDirectionByCoord, AddNewPointCoord, AddNewCylinder ' noch zu bearbeiten Dim reference11 As Reference Set reference11 = CATIA.ActiveDocument.Part.CreateReferenceFromBRepName(objHoleThread_NameLateralFaceElement1, hole1) Dim hybridShapeAxisLine1 As HybridShapeAxisLine Set hybridShapeAxisLine1 = CATIA.ActiveDocument.PartHybridShapeFactory.AddNewAxisLine(reference11) 'objHoleThread.LateralFaceElement = reference11 Dim reference21 As Reference Set reference21 = CATIA.ActiveDocument.Part.CreateReferenceFromBRepName(objHoleThread_NameLimitFaceElement1, hole1) hybridShapeAxisLine1.AxisLineType = 1 hybridBody1.AppendHybridShape hybridShapeAxisLine1 Dim coordArrayThreadThread(2) objHoleThread.GetOrigin coordArrayThread XcoordArrayThread = coordArrayThread(0) YcoordArrayThread = coordArrayThread(1) ZcoordArrayThread = coordArrayThread(2) Set hybridShapePointCoord1 = hybridShapeFactory1.AddNewPointCoord(XcoordArrayThread, YcoordArrayThread, ZcoordArrayThread) Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces") hybridBody1.AppendHybridShape hybridShapePointCoord1 part1.InWorkObject = hybridShapePointCoord1 part1.Update 'Dim dirArrayThread(2) 'objHole.GetDirection dirArrayThread 'XdirArrayThread = dirArrayThread(0) 'YdirArrayThread = dirArrayThread(1) 'ZdirArrayThread = dirArrayThread(2) 'create explicit direction Set objHoleDirection = hybridShapeFactory1.AddNewDirectionByCoord(XdirArrayThread, YdirArrayThread, ZdirArrayThread) Dim refHoleDirectionThread As Reference Set refHoleDirectionThread = part1.CreateReferenceFromObject(objHoleDirection) hybridBody1.AppendHybridShape objHoleDirection part1.Update Dim reference1Thread As Reference Set reference1Thread = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeCylinder1Thread As HybridShapeCylinder Set hybridShapeCylinder1Thread = hybridShapeFactory1.AddNewCylinder(reference1Thread, Durchmesser_Gewinde / 2, Gewinde_Tiefe, 0#, objHoleDirection) hybridShapeCylinder1Thread.Orientation = False hybridBody1.AppendHybridShape hybridShapeCylinder1Thread part1.InWorkObject = hybridShapeCylinder1Thread hybridShapeCylinder1Thread_Name = objHole.Name hybridShapeCylinder1Thread.Name = "Surface_" & hybridShapeCylinder1_Name part1.Update Next
End If End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Estafanos Mitglied
Beiträge: 27 Registriert: 17.07.2012 Catia V5 R22, Windows 7
|
erstellt am: 27. Feb. 2017 11:35 <-- editieren / zitieren --> Unities abgeben:
Hallo Bernd, 1000 Dank für die Methode. Diese Methode hat gestern auf einem Rechner sehr gut funktioniert. Jetzt auf einem anderen Rechner nicht mehr. Es tut mir leid diesen Code nochmal hochladen zu müssen, aber vielleicht kannst mir einen Tipp geben, wo der Fehler sein könnte? Es kommt zu der Fehlermeldung "The method GetCoG failed". Besten Dank Estafanos Code:
Sub CATMain() Dim partDocument1 As PartDocument Set partDocument1 = CATIA.ActiveDocument Dim part1 As Part Set part1 = partDocument1.Part Dim ohyBody Dim hybridBodies1 As HybridBodies Set hybridBodies1 = part1.HybridBodies Set ohyBody = hybridBodies1.Add() ohyBody.Name = "Theard_Surfaces" Set hybridBody1 = hybridBodies1.Item("Theard_Surfaces") Dim hybridShapes1 As HybridShapes Set hybridShapes1 = hybridBody1.HybridShapes part1.InWorkObject = ohyBody Dim hybridShapeFactory1 As HybridShapeFactory Set hybridShapeFactory1 = part1.HybridShapeFactory part1.Update Dim objSel As Selection Dim objHole, objChamfer, objFillet, objThread, objThickness 'As Variant Dim i As Integer Set objSel = partDocument1.Selection 'Außengewinde objSel.Clear objSel.Search "CATPrtSearch.Thread,all" If objSel.Count > 0 Then For i = 1 To objSel.Count Dim objHoleThread_Name1 Dim objHoleThread_Diameter Dim objHoleThread_Pitch Dim objHoleThread_Depth Dim HoleThreadDescription Dim objHoleThread_LimitFaceElement Dim objHoleThread_NameLateralFaceElement Dim objHoleThread Dim UserSel Set UserSel = objSel.Item(i).Value Dim TheSPAWorkbench Dim Inertia1 Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") Set Inertia1 = TheSPAWorkbench.Inertias.Add(UserSel) 'Parameter Einlesen objHoleThread_Name1 = UserSel.Name 'Thread.Name objHoleThread_Diameter = UserSel.Diameter 'Durchmesser objHoleThread_Pitch = UserSel.Pitch 'Steigung objHoleThread_Depth = UserSel.Depth 'Tiefe Set HoleThreadDescription = UserSel.ThreadDescription 'ThreadDescription
Set part1 = CATIA.ActiveDocument.Part objHoleThread_NameLateralFaceElement = UserSel.LateralFaceElement.DisplayName 'LateralFaceElement Dim objHoleThread_NameLateralFaceElement1 As String objHoleThread_NameLateralFaceElement1 = "" objHoleThread_NameLateralFaceElement1 = objHoleThread_NameLateralFaceElement Dim refobjHoleThread_NameLateralFaceElement As Reference Set refobjHoleThread_NameLateralFaceElement = CATIA.ActiveDocument.Part.CreateReferenceFromName(objHoleThread_NameLateralFaceElement1) objHoleThread_NameLimitFaceElement = UserSel.LimitFaceElement.DisplayName 'LimitFaceElement Dim objHoleThread_NameLimitFaceElement1 As String objHoleThread_NameLimitFaceElement1 = "" objHoleThread_NameLimitFaceElement1 = objHoleThread_NameLimitFaceElement Dim refobjHoleThread_NameLimitFaceElement As Reference Set refobjHoleThread_NameLimitFaceElement = CATIA.ActiveDocument.Part.CreateReferenceFromName(objHoleThread_NameLimitFaceElement1) 'Schwerpunkt Dim reference1 Dim Measurable1 Set reference1 = part1.CreateReferenceFromObject(UserSel) Set Measurable1 = TheSPAWorkbench.GetMeasurable(refobjHoleThread_NameLateralFaceElement) Dim GcoordLateralFaceElement(2) Measurable1.GetCOG GcoordLateralFaceElement 'GetAxis Dim Measurable3 Set Measurable3 = TheSPAWorkbench.GetMeasurable(reference1) Dim oAxisVector(2) Measurable1.GetAxis oAxisVector 'GetAxis
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: 27. Feb. 2017 11:52 <-- editieren / zitieren --> Unities abgeben: Nur für Estafanos
Servus Estafanos Ich kann dir leider nicht weiterhelfen, bei meinen Tests hat eine Messung an den Referenzelementen der Gewinde nie geklappt. 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 >>)
|