Autor
|
Thema: CATPart erstellen Kugeln mit Makro. (2517 mal gelesen)
|
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 06. Mrz. 2012 23:35 <-- editieren / zitieren --> Unities abgeben:
Hallo Jungs! Ich möchte ein Makro, um Kugeln in allen vorhandenen Punkte einfügen, wie man es an einer Stelle zu tun, aber nicht, wie man alle Elemente auszuwählen und eine Kugel an jedem Punkt zu machen. Können Sie helfen? Code: Language="VBSCRIPT"Sub CATMain() Dim partDocument1 As Document 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("Geometrical Set.1") Dim hybridShapes1 As HybridShapes Set hybridShapes1 = hybridBody1.HybridShapes Dim hybridShapePointCoord1 As HybridShape Set hybridShapePointCoord1 = hybridShapes1.Item("Point.1") Dim reference1 As Reference Set reference1 = part1.CreateReferenceFromObject(hybridShapePointCoord1) Dim axisSystems1 As AxisSystems Set axisSystems1 = part1.AxisSystems Dim axisSystem1 As AxisSystem Set axisSystem1 = axisSystems1.Item("Absolute Axis System") Dim reference2 As Reference Set reference2 = part1.CreateReferenceFromObject(axisSystem1) Dim hybridShapeFactory1 As Factory Set hybridShapeFactory1 = part1.HybridShapeFactory Dim hybridShapeSphere1 As HybridShapeSphere Set hybridShapeSphere1 = hybridShapeFactory1.AddNewSphere(reference1, reference2, 5.000000, -45.000000, 45.000000, 0.000000, 180.000000) hybridShapeSphere1.Limitation = 1 hybridBody1.AppendHybridShape hybridShapeSphere1 part1.InWorkObject = hybridShapeSphere1 part1.Update End Sub
Dies ist der Code I aber nur bis zu einem Punkt erreicht haben. Vielen Dank M.f.G. Manuel
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Thomas Harmening Ehrenmitglied V.I.P. h.c. Arbeiter ツ
Beiträge: 2897 Registriert: 06.07.2001 NX 10 Win 7
|
erstellt am: 07. Mrz. 2012 12:36 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
|
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 07. Mrz. 2012 15:08 <-- editieren / zitieren --> Unities abgeben:
|
ferdo Mitglied engineer
Beiträge: 34 Registriert: 15.04.2009 Windows 7, 64 CATIA v5r25 , 3DEXPERIENCE on cloud
|
erstellt am: 07. Mrz. 2012 19:51 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
Language="VBSCRIPT" Sub CATMain() Msgbox "Select geometrical set containing points to create spheres" Dim Document,Part,Selection,HybridShapeFactory,HybridBodies,HybridBody,OriginElements,Plane,PlaneReference,Status Dim InputObjectType(0),PointIndex,PointReference,HybridShapeSymmetry Set Document = CATIA.ActiveDocument : Set Part = Document.Part : Set Selection = Document.Selection Set HybridShapeFactory = Part.HybridShapeFactory InputObjectType(0)="HybridBody" Status=Selection.SelectElement3(InputObjectType,"Select geometrical set containing points", _ true,CATMultiSelTriggWhenSelPerf,false) if (Status = "Cancel") then Exit Sub set hybridbody1 = Selection.Item(1).Value Dim Dia As String Dim DiaInch As Integer Dia = InputBox("What Radius Size? - Spheres will have radius in mm") DiaMm = Dia '~ DiaInch = Dia * 25.4 Dim hybridShapes1 As HybridShapes Set hybridShapes1 = hybridBody1.HybridShapes For s=1 to hybridShapes1.Count Dim hybridShapePointCoord1 As HybridShape Set hybridShapePointCoord1 = hybridShapes1.Item(s) Dim reference1 As Reference Set reference1 = part.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeFactory1 As Factory Set hybridShapeFactory1 = part.HybridShapeFactory Dim hybridShapeSphere1 As HybridShapeSphere Set hybridShapeSphere1 = hybridShapeFactory1.AddNewSphere(reference1, Nothing, DiaMm, -45.000000, 45.000000, 0.000000, 180.000000) hybridShapeSphere1.Limitation = 1 hybridBody1.AppendHybridShape hybridShapeSphere1 part.Update Next End Sub ------------------ Best regards Fernando Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
ferdo Mitglied engineer
Beiträge: 34 Registriert: 15.04.2009 Windows 7, 64 CATIA v5r25 , 3DEXPERIENCE on cloud
|
erstellt am: 07. Mrz. 2012 19:58 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
Hallo, Language="VBSCRIPT" Sub CATMain() Msgbox "Select geometrical set containing points to create spheres" Dim Document,Part,Selection,HybridShapeFactory,HybridBodies,HybridBody,OriginElements,Plane,PlaneReference,Status Dim InputObjectType(0),PointIndex,PointReference,HybridShapeSymmetry Set Document = CATIA.ActiveDocument : Set Part = Document.Part : Set Selection = Document.Selection Set HybridShapeFactory = Part.HybridShapeFactory InputObjectType(0)="HybridBody" Status=Selection.SelectElement3(InputObjectType,"Select geometrical set containing points", _ true,CATMultiSelTriggWhenSelPerf,false) if (Status = "Cancel") then Exit Sub set hybridbody1 = Selection.Item(1).Value Dim Dia As String Dim DiaInch As Integer Dia = InputBox("What Radius Size? - Spheres will have radius in mm") DiaMm = Dia '~ DiaInch = Dia * 25.4 Dim hybridShapes1 As HybridShapes Set hybridShapes1 = hybridBody1.HybridShapes For s=1 to hybridShapes1.Count Dim hybridShapePointCoord1 As HybridShape Set hybridShapePointCoord1 = hybridShapes1.Item(s) Dim reference1 As Reference Set reference1 = part.CreateReferenceFromObject(hybridShapePointCoord1) Dim hybridShapeFactory1 As Factory Set hybridShapeFactory1 = part.HybridShapeFactory Dim hybridShapeSphere1 As HybridShapeSphere Set hybridShapeSphere1 = hybridShapeFactory1.AddNewSphere(reference1, Nothing, DiaMm, -45.000000, 45.000000, 0.000000, 180.000000) hybridShapeSphere1.Limitation = 1 hybridBody1.AppendHybridShape hybridShapeSphere1 part.Update Next End Sub ------------------ Best regards Fernando Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|