Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  CATIA V5 Programmierung
  CATPart erstellen Kugeln mit Makro.

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:  CATPart erstellen Kugeln mit Makro. (2517 mal gelesen)
xyon126
Mitglied
Ingenieur


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

Beiträge: 74
Registriert: 07.11.2011

erstellt am: 06. Mrz. 2012 23:35    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 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 ツ



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

Beiträge: 2897
Registriert: 06.07.2001

NX 10
Win 7

erstellt am: 07. Mrz. 2012 12:36    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 xyon126 10 Unities + Antwort hilfreich

xyon126
Mitglied
Ingenieur


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

Beiträge: 74
Registriert: 07.11.2011

erstellt am: 07. Mrz. 2012 15:08    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 Thomas!

      Vielen Dank, Ich versuche es jetzt.
M.f.G.
Manuel

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

ferdo
Mitglied
engineer


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

Beiträge: 34
Registriert: 15.04.2009

Windows 7, 64
CATIA v5r25 , 3DEXPERIENCE on cloud

erstellt am: 07. Mrz. 2012 19:51    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 xyon126 10 Unities + Antwort hilfreich

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


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

Beiträge: 34
Registriert: 15.04.2009

Windows 7, 64
CATIA v5r25 , 3DEXPERIENCE on cloud

erstellt am: 07. Mrz. 2012 19:58    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 xyon126 10 Unities + Antwort hilfreich

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 >>)

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