Seznam příspěvků uživatele

Option Explicit

Sub CATMAin()

'****PODMIENKY****

'Treba si vytvorit part

'V nom vytvorit Geometricky Set s nazvom Geometrical Set.1

'Vytvorit zopar bodov (v 3D) a potom spline

'Pozor Spline sa musi volat Spline.1 !!!

'----------------------------------------------

'Trocha so si pomohol s resolution object kvoli lenivosti



'---- Begin resolution script For object : Spline.1

Dim partDocument1 As PartDocument

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 hybridShapeSpline1 As HybridShapeSpline

Set hybridShapeSpline1 = hybridShapes1.Item("Spline.1")

'---- End resolution script

Dim oPoint As Point ' Definujeme si nAs Bod o ktorom zistime info

Dim oRefpunkt As Reference ' Potrebujeme si vytvorit referenciu z bodu, kvoli metode GetpointPosition

Dim oPocetbodov, i, oPoradiebodu As Long

oPocetbodov = hybridShapeSpline1.GetNbControlPoint ' Hodi nam cislo z kolkych bodov

                                                   ' sa sklada nasa Spline.1



'Teraz si prejdeme bod po bode z ktorych sa slada spline

For i = 1 To oPocetbodov

    Set oPoint = hybridShapeSpline1.Parent.Item(i) ' nastavime BOD

    Set oRefpunkt = oPoint ' nastavime referenciu

    oPoradiebodu = hybridShapeSpline1.GetPointPosition(oRefpunkt) ' tuna mame poradie bodu

    MsgBox "Bod s nazvom " & oPoint.Name & vbNewLine & "ma poradove cislo " & oPoradiebodu

Next i

' No a potom uz len najvyssie cislo z premennej oPoradiebodu je posledny bod na spline

' a analogicky poradove cislo jeden bude nAs prvy bod.

End Sub

Sub Catmain()

MsgBox NAJDICESTU

End Sub



Function NAJDICESTU()

   Dim apc

   Set apc = CreateObject("MSAPC.Apc")

   Dim oCesta, oAdresar As String

   

   oCesta = apc.vbE.ActiveVBProject.FileName

   oAdresar = Left(oCesta, InStrRev(oCesta, "\") - 1)

   NAJDICESTU = oAdresar

   

End Function

' Vytvori GS s nazvami - GS,WIN,Extracts,Work

Sub CATMain()



On Error GoTo ErrHandler

Dim oDoc As Document

Set oDoc = CATIA.ActiveDocument



Dim oPart As Part

Set oPart = oDoc.Part





Dim HBs As HybridBodies

Set HBs = oPart.HybridBodies









Dim HBWRK, HBIN, HBNAZOV, HBINPUTS, HBExtracts As HybridBody

Dim nazov As String

nazov = InputBox("Zadaj nazov GEometrickeho Setu")

 If nazov = "" Then Exit Sub



' Natsav GS kde si aktvny

Dim kde As HybridBodies

Set kde = oPart.InWorkObject



'Set Hbs = Hbs.Item(CStr(Kde))



Set HBNAZOV = kde.Add

HBNAZOV.Name = CStr(nazov)





Set HBs = kde.Item(CStr(nazov))

Set HBIN = HBs.Add

HBIN.Name = "IN"



Dim IN2 As HybridBodies

Set IN2 = HBs.Item("IN")

Set Extracts = IN2.Add

Extracts.Name = "Extracts "





Set HBWRK = HBs.Add

HBWRK.Name = "WORK"





oPart.InWorkObject = Extracts



Exit Sub



'Error handler

ErrHandler:

 MsgBox "Sry,kamo - Musis si otvorit part zvlast a nie pracovat v Assemly"

 

 End Sub

....(BEdge:(Brp:(Sketch.1;'bold'> " & (PNum) & " )....

....(BEdge:(Brp:(Sketch.1;'bold'>PNum)....

Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:(Sketch.1;1);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)

'-------------------- SLUCKA PRE BODY ---------

 

  Dim SGEO As GeometricElements

  Set SGEO = sketch1.GeometricElements

   

  

'For i = 1 To SGEO.Count

  Dim PNum As Integer

 PNum = 1

MsgBox PNum

  

Dim reference2 As Reference

Set reference2 = part1.CreateReferenceFromBRepName("BorderFVertex:(BEdge:(Brp:'bold'>(Sketch.1;PNum);None:(Limits1:();Limits2:();+1);Cf11:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", sketch1)



Dim hybridShapeCylinder1 As HybridShapeCylinder

Set hybridShapeCylinder1 = hybridShapeFactory1.AddNewCylinder(reference2, 20#, 27#, 18#, hybridShapeDirection1)

 

 



hybridBody1.AppendHybridShape hybridShapeCylinder1

'Next 'i



part1.InWorkObject = hybridShapeCylinder1



part1.Update