Catia VBA

[NaWin55]

Hello All.
I am trying to draft this pad using VBA, i recorded the macro for draft but i am not getting some part of it and i want to know how to select faces in a PAD feature and create Draft
here is the recorded code that i am not understanding the reference 20,21,22,23

Sub CATMain()

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim sketches1 As Sketches
Set sketches1 = body1.Sketches

Dim sketch1 As Sketch
Set sketch1 = sketches1.Item("Sketch.1")

Dim factory2D1 As Factory2D
Set factory2D1 = sketch1.OpenEdition()

Dim geometricElements1 As GeometricElements
Set geometricElements1 = sketch1.GeometricElements

Dim axis2D1 As Axis2D
Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

Dim line2D1 As Line2D
Set line2D1 = axis2D1.GetItem("HDirection")

line2D1.ReportName = 1

Dim line2D2 As Line2D
Set line2D2 = axis2D1.GetItem("VDirection")

line2D2.ReportName = 2

Dim point2D1 As Point2D
Set point2D1 = factory2D1.CreatePoint(10#, 10#)

point2D1.ReportName = 3

Dim point2D2 As Point2D
Set point2D2 = factory2D1.CreatePoint(10#, -10#)

point2D2.ReportName = 4

Dim line2D3 As Line2D
Set line2D3 = factory2D1.CreateLine(10#, 10#, 10#, -10#)

line2D3.ReportName = 5

line2D3.StartPoint = point2D1

line2D3.EndPoint = point2D2

Dim point2D3 As Point2D
Set point2D3 = factory2D1.CreatePoint(-10#, -10#)

point2D3.ReportName = 6

Dim line2D4 As Line2D
Set line2D4 = factory2D1.CreateLine(10#, -10#, -10#, -10#)

line2D4.ReportName = 7

line2D4.StartPoint = point2D2

line2D4.EndPoint = point2D3

Dim point2D4 As Point2D
Set point2D4 = factory2D1.CreatePoint(-10#, 10#)

point2D4.ReportName = 8

Dim line2D5 As Line2D
Set line2D5 = factory2D1.CreateLine(-10#, -10#, -10#, 10#)

line2D5.ReportName = 9

line2D5.StartPoint = point2D3

line2D5.EndPoint = point2D4

Dim line2D6 As Line2D
Set line2D6 = factory2D1.CreateLine(-10#, 10#, 10#, 10#)

line2D6.ReportName = 10

line2D6.StartPoint = point2D4

line2D6.EndPoint = point2D1

Dim constraints1 As Constraints
Set constraints1 = sketch1.Constraints

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(line2D3)

Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(line2D2)

Dim constraint1 As Constraint
Set constraint1 = constraints1.AddBiEltCst(catCstTypeVerticality, reference1, reference2)

constraint1.Mode = catCstModeDrivingDimension

Dim reference3 As Reference
Set reference3 = part1.CreateReferenceFromObject(line2D4)

Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromObject(line2D1)

Dim constraint2 As Constraint
Set constraint2 = constraints1.AddBiEltCst(catCstTypeHorizontality, reference3, reference4)

constraint2.Mode = catCstModeDrivingDimension

Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(line2D5)

Dim reference6 As Reference
Set reference6 = part1.CreateReferenceFromObject(line2D2)

Dim constraint3 As Constraint
Set constraint3 = constraints1.AddBiEltCst(catCstTypeVerticality, reference5, reference6)

constraint3.Mode = catCstModeDrivingDimension

Dim reference7 As Reference
Set reference7 = part1.CreateReferenceFromObject(line2D6)

Dim reference8 As Reference
Set reference8 = part1.CreateReferenceFromObject(line2D1)

Dim constraint4 As Constraint
Set constraint4 = constraints1.AddBiEltCst(catCstTypeHorizontality, reference7, reference8)

constraint4.Mode = catCstModeDrivingDimension

Dim reference9 As Reference
Set reference9 = part1.CreateReferenceFromObject(line2D3)

Dim reference10 As Reference
Set reference10 = part1.CreateReferenceFromObject(line2D5)

Dim point2D5 As Point2D
Set point2D5 = axis2D1.GetItem("Origin")

Dim reference11 As Reference
Set reference11 = part1.CreateReferenceFromObject(point2D5)

Dim constraint5 As Constraint
Set constraint5 = constraints1.AddTriEltCst(catCstTypeEquidistance, reference9, reference10, reference11)

constraint5.Mode = catCstModeDrivingDimension

Dim reference12 As Reference
Set reference12 = part1.CreateReferenceFromObject(line2D4)

Dim reference13 As Reference
Set reference13 = part1.CreateReferenceFromObject(line2D6)

Dim reference14 As Reference
Set reference14 = part1.CreateReferenceFromObject(point2D5)

Dim constraint6 As Constraint
Set constraint6 = constraints1.AddTriEltCst(catCstTypeEquidistance, reference12, reference13, reference14)

constraint6.Mode = catCstModeDrivingDimension

Dim reference15 As Reference
Set reference15 = part1.CreateReferenceFromObject(point2D1)

Dim reference16 As Reference
Set reference16 = part1.CreateReferenceFromObject(line2D2)

Dim constraint7 As Constraint
Set constraint7 = constraints1.AddBiEltCst(catCstTypeDistance, reference15, reference16)

constraint7.Mode = catCstModeDrivingDimension

Dim length1 As Length
Set length1 = constraint7.Dimension

length1.Value = 10#

Dim reference17 As Reference
Set reference17 = part1.CreateReferenceFromObject(point2D1)

Dim reference18 As Reference
Set reference18 = part1.CreateReferenceFromObject(line2D1)

Dim constraint8 As Constraint
Set constraint8 = constraints1.AddBiEltCst(catCstTypeDistance, reference17, reference18)

constraint8.Mode = catCstModeDrivingDimension

Dim length2 As Length
Set length2 = constraint8.Dimension

length2.Value = 10#

sketch1.CloseEdition

part1.InWorkObject = sketch1

part1.Update

Dim shapeFactory1 As shapefactory
Set shapeFactory1 = part1.shapefactory

Dim pad1 As Pad
Set pad1 = shapeFactory1.AddNewPad(sketch1, 20#)

Dim limit1 As Limit
Set limit1 = pad1.FirstLimit

Dim length3 As Length
Set length3 = limit1.Dimension

length3.Value = 59#

length3.Value = 60#

part1.Update

Dim reference19 As Reference
Set reference19 = part1.CreateReferenceFromName("")

Dim draft1 As Draft
Set draft1 = shapeFactory1.AddNewDraft(reference19, reference19, catNoneDraftNeutralPropagationMode, reference19, 0#, 0#, 1#, catStandardDraftMode, 5#, catNoneDraftMultiselectionMode)

Dim draftDomains1 As DraftDomains
Set draftDomains1 = draft1.DraftDomains

Dim draftDomain1 As DraftDomain
Set draftDomain1 = draftDomains1.Item(1)

draftDomain1.SetPullingDirection 0#, 0#, 1#

Dim reference20 As Reference
Set reference20 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;0BrpSketch.1;10)));None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.AddFaceToDraft reference20

Dim reference21 As Reference
Set reference21 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;0BrpSketch.1;9)));None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.AddFaceToDraft reference21

Dim reference22 As Reference
Set reference22 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;0BrpSketch.1;7)));None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.AddFaceToDraft reference22

draftDomain1.SetPullingDirection 1#, 0#, 0#

Dim reference23 As Reference
Set reference23 = part1.CreateReferenceFromBRepName("FSurFaceBrpPad.1;2);None);Cf11));WithTemporaryBody;WithoutBuildError;WithInitialFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.PullingDirectionElement = reference23

Dim reference24 As Reference
Set reference24 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;2);None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.NeutralElement = reference24

Dim angle1 As Angle
Set angle1 = draftDomain1.DraftAngle

angle1.Value = 3#

part1.Update

Set partDocument1 = CATIA.ActiveDocument

partDocument1.SaveAs "D:\CATIA MACRO\DraftVBA.CATPart"

End Sub


I am not understanding the CREATEFROMREFERENCE() Part

Dim reference20 As Reference
Set reference20 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;0BrpSketch.1;10)));None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)

draftDomain1.AddFaceToDraft reference20

Dim reference21 As Reference
Set reference21 = part1.CreateReferenceFromBRepName("RSurFaceBrpPad.1;0BrpSketch.1;9)));None);Cf11));WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)


How do i make vba automatically select required faces to draft


Here is the Pad that is drafted

Here is the Pad file that i want draft

 

[catiavbmacro]

Hello

Language="VBSCRIPT"

Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part
Set part1 = partDocument1.Part

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory

Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromName("")

Dim draft1 As Draft
Set draft1 = shapeFactory1.AddNewDraft(reference1, reference1, catNoneDraftNeutralPropagationMode, reference1, 0.000000, 0.000000, 1.000000, catStandardDraftMode, 5.000000, catNoneDraftMultiselectionMode)

Dim draftDomains1 As DraftDomains
Set draftDomains1 = draft1.DraftDomains

Dim draftDomain1 As DraftDomain
Set draftDomain1 = draftDomains1.Item(1)

draftDomain1.SetPullingDirection 0.000000, 0.000000, 1.000000

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim pad1 As Shape
Set pad1 = shapes1.Item("Pad.1")

dim oSel as Selection
Set oSel = CATIA.ActiveDocument.Selection
Dim Filter(0)
Filter(0)="Face"
Dim F_Body as object
F_Body=oSel.selectelement2(Filter, " Select Body in which you want to add", False)


Dim reference2 As Reference
Set reference2 = oSel.item(1).value

draftDomain1.AddFaceToDraft reference2

draftDomain1.SetPullingDirection 1.000000, 0.000000, 0.000000

oSel.clear
F_Body=oSel.selectelement2(Filter, " Select Body in which you want to add", False)

Dim reference3 As Reference
'Set reference3 = part1.CreateReferenceFromBRepName("FSur:(Face:(Brp:(Pad.1;2);None:();Cf11:());WithTemporaryBody;WithoutBuildError;WithInitialFeatureSupport;MFBRepVersion_CXR15)", pad1)
Set reference3=oSel.item(1).value

draftDomain1.PullingDirectionElement = reference3

Dim reference4 As Reference
'Set reference4 = part1.CreateReferenceFromBRepName("RSur:(Face:(Brp:(Pad.1;2);None:();Cf11:());WithTemporaryBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)", pad1)
Set reference4=oSel.item(1).value
draftDomain1.NeutralElement = reference4

part1.Update 

End Sub

Here is code for one drafted face, I used selection, but I left you reference to see the change.
In your case, you have 4 faces to draft so you will need to use for loop for those and you will need to select that referent face one time.

See more cool macros [link catiavbmacro.com]catiavbmacro.com[/url]

 

[NaWin55]

Hey Thanks for quick replay.
I followed your code but getting these errors

 

[catiavbmacro]

Hello,
don't use that BrpName for reference, go with selection for the first error.
I sent you an example for CATScript, this is some other environment as I can see.
Try to go with Dim F_body As String instead of an object.

Check this post for selection and how to go with for loop

https://catiavbmacro.com/2018/08/26/catia-macro-selection/

 

[NaWin55]

Hey I tried Declaring F_body as string but still same error
and i cant figure out how to what to do with BrpName
here is the complete code
Option Explicit


'Doghouse Creation
'Step1: Create Body and geometrical sets
'Step2: Add originpoint, tooling direction and planes
'Step3: Create Lines to create base sketch for pad
'Step4: Create join from lines
'Step5: Creating Pad
'Step6: Apply Draft
'....................................................................................
Private Sub CancelCreation_Click()
Unload Me
End Sub
'Step1
Private Sub Doghouse2_Click()

Dim myDoc As Document
Dim myPart As Part
Dim hyBBody As HybridBody
Dim hybBody2 As HybridBody
Dim obody As Body

Set myDoc = CATIA.Documents.Add("Part") 'Creating Document
Set myPart = CATIA.ActiveDocument.Part 'Setting Part as Active part
Set hyBBody = myPart.HybridBodies.Add 'Creating Geometrical set
Set hybBody2 = myPart.HybridBodies.Add
hyBBody.Name = "Reference Elements" 'Naming Gset
hybBody2.Name = "WireFrame"
Set obody = myPart.Bodies.Add 'Creating PartBody

'Step2
Dim hybShape As HybridShapeFactory
Dim xyPlane As Reference
Dim point1 As HybridShapePointCoord
Dim point2 As HybridShapePointCoord
Dim oToolingDirection As HybridShapeLinePtDir
Dim oSliderDirection As HybridShapeLinePtDir
Dim oDirection As HybridShapeDirection
Dim oDirection2 As HybridShapeDirection

Set hybShape = myPart.HybridShapeFactory 'Set HYbridShapeFactory to access wireframe elements
Set xyPlane = myPart.CreateReferenceFromObject(myPart.OriginElements.PlaneXY) 'Set the required Plane
Set oDirection = hybShape.AddNewDirectionByCoord(0, 0, 1)
Set oDirection2 = hybShape.AddNewDirectionByCoord(1, 0, 0)
Set point1 = hybShape.AddNewPointCoord(5, 5, 0) 'Ceate point with required co-ordinates
Set point2 = hybShape.AddNewPointCoord(0, 5, 0)

hyBBody.AppendHybridShape point1
myPart.UpdateObject point1

Set oToolingDirection = hybShape.AddNewLinePtDir(point1, oDirection, 10, 30, False) 'Creating Tooling Direction

hyBBody.AppendHybridShape oToolingDirection
myPart.UpdateObject oToolingDirection

Set oSliderDirection = hybShape.AddNewLinePtDir(point2, oDirection2, 10, 30, False) 'Creating Slider Direction

hyBBody.AppendHybridShape oSliderDirection

myPart.UpdateObject oSliderDirection

myPart.Update

'Step3
Dim xdir As Double
Dim ydir As Double
ydir = 0
Dim zdir As Double

Dim i As Integer
For i = 1 To 1
Dim value1 As Double
value1 = i * 0
Dim value2 As Double
value2 = i + ydir + 9
Dim value3 As Double
value3 = i * 0
Dim opoint1 As HybridShapePointCoord
Set opoint1 = hybShape.AddNewPointCoord(value1, value2, value1)

hybBody2.AppendHybridShape opoint1
myPart.UpdateObject opoint1

Dim opoint2 As HybridShapePointCoord
Set opoint2 = hybShape.AddNewPointCoord(value2, value2, value3)

hybBody2.AppendHybridShape opoint2
myPart.UpdateObject opoint2

Dim opoint3 As HybridShapePointCoord
Set opoint3 = hybShape.AddNewPointCoord(value2, value1, value1)

hybBody2.AppendHybridShape opoint3
myPart.UpdateObject opoint3

Dim opoint4 As HybridShapePointCoord
Set opoint4 = hybShape.AddNewPointCoord(value1, value1, value1)

hybBody2.AppendHybridShape opoint4
myPart.UpdateObject opoint4

Next
'Creating lines
myPart.Update

Dim oLine1 As Line
Set oLine1 = hybShape.AddNewLinePtPt(opoint4, opoint1)

hybBody2.AppendHybridShape oLine1

myPart.UpdateObject oLine1

Dim oLine2 As Line
Set oLine2 = hybShape.AddNewLinePtPt(opoint1, opoint2)

hybBody2.AppendHybridShape oLine2

myPart.UpdateObject oLine2

Dim oLine3 As Line
Set oLine3 = hybShape.AddNewLinePtPt(opoint2, opoint3)

hybBody2.AppendHybridShape oLine3

myPart.UpdateObject oLine3

Dim oLine4 As Line
Set oLine4 = hybShape.AddNewLinePtPt(opoint3, opoint4)

hybBody2.AppendHybridShape oLine4

myPart.UpdateObject oLine4

myPart.Update

'Step4
Dim oJoin As HybridShapeAssemble
Set oJoin = hybShape.AddNewJoin(oLine1, oLine2)

Dim hybShapes As HybridShapes
Set hybShapes = hybBody2.HybridShapes

Dim line1 As HybridShapeLinePtPt
Set line1 = hybShapes.Item("Line.5")

Dim line2 As HybridShapeLinePtPt
Set line2 = hybShapes.Item("Line.6")

Dim reference1 As Reference
Set reference1 = myPart.CreateReferenceFromObject(line1)

oJoin.AddElement reference1

Dim reference2 As Reference
Set reference2 = myPart.CreateReferenceFromObject(line2)

oJoin.AddElement reference2

oJoin.SetConnex True

oJoin.SetManifold True

oJoin.SetSimplify False

oJoin.SetSuppressMode False

oJoin.SetDeviation 0.05

oJoin.SetAngularToleranceMode False

oJoin.SetAngularTolerance 0.5

oJoin.SetFederationPropagation 0

hybBody2.AppendHybridShape oJoin

myPart.UpdateObject oJoin

myPart.Update

'Step5
Dim shapefactory As shapefactory 'invoke shapefactory
Set shapefactory = myPart.shapefactory

Dim refeence3 As Reference
Set refeence3 = myPart.CreateReferenceFromObject(oJoin) 'Create reference from join to input as sketch for pad

Dim oPad As Pad
Set oPad = shapefactory.AddNewPadFromRef(refeence3, -20)

'Step6
Dim partDocument2 As Documents
Set partDocument2 = CATIA.ActiveDocument.Part

Dim part1 As Part
Set part1 = partDocument2.Part

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.shapefactory

Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromName("")

Dim Draft1 As Draft
Set Draft1 = shapefactory.AddNewDraft(reference4, reference4, catNoneDraftNeutralPropagationMode, reference4, 0, 0, 1, catStandardDraftMode, 3, catNoneDraftMultiselectionMode)

Dim draftDomain1 As DraftDomains
Set draftDomain1 = Draft1.DraftDomains

Dim draftDomain2 As DraftDomain
Set draftDomain2 = draftDomain1.Item(1)

draftDomain2.SetPullingDirection 0, 0, 1

Dim bodies1 As Bodies
Set bodies1 = myPart.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("Body.2")

Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection
Filter(0) = "Face"
Dim fBody As String
fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)

Dim reference5 As Reference
Set reference5 = oSel.Item(1).Value

draftDomain2.AddFaceToDraft reference5
draftDomain2.SetPullingDirection 0, 0, 1

oSel.Clear

fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)
Dim reference6 As Reference
Set reference6 = oSel.Item(1).Value

draftDomain2.PullingDirectionElement = reference6

fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)
Dim reference7 As Reference
Set reference7 = oSel.Item(1).Value

draftDomain2.NeutralElement = reference7

myPart.Update

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.ActiveDocument
partDocument1.SaveAs "D:\CATIA MACRO\Engineering feature\Doghouse.CATPart" 'Save the Document



myPart.Update

End Sub

Private Sub Thickness_Change()

End Sub

 

[catiavbmacro]

Hello,
I check your code and fix some stuff, please compare code for differences, I ran it again in CATScript.

'Doghouse Creation
'Step1: Create Body and geometrical sets
'Step2: Add originpoint, tooling direction and planes
'Step3: Create Lines to create base sketch for pad
'Step4: Create join from lines
'Step5: Creating Pad
'Step6: Apply Draft
'....................................................................................
'Private Sub CancelCreation_Click()
'Unload Me
'End Sub

Sub CATMain()
'Step1
'Private Sub Doghouse2_Click()

Dim myDoc As Document
Dim myPart As Part
Dim hyBBody As HybridBody
Dim hybBody2 As HybridBody
Dim obody As Body



Dim documents1 As Documents
Set documents1 = CATIA.Documents
Set myDoc = CATIA.Documents.Add("Part") 'Creating Document
Set myPart = CATIA.ActiveDocument.Part 'Setting Part as Active part
Set hyBBody = myPart.HybridBodies.Add 'Creating Geometrical set
Set hybBody2 = myPart.HybridBodies.Add
hyBBody.Name = "Reference Elements" 'Naming Gset
hybBody2.Name = "WireFrame"
Set obody = myPart.Bodies.Add 'Creating PartBody

'Step2
Dim hybShape As HybridShapeFactory
Dim xyPlane As Reference
Dim point1 As HybridShapePointCoord
Dim point2 As HybridShapePointCoord
Dim oToolingDirection As HybridShapeLinePtDir
Dim oSliderDirection As HybridShapeLinePtDir
Dim oDirection As HybridShapeDirection
Dim oDirection2 As HybridShapeDirection

Set hybShape = myPart.HybridShapeFactory 'Set HYbridShapeFactory to access wireframe elements
Set xyPlane = myPart.CreateReferenceFromObject(myPart.OriginElements.PlaneXY) 'Set the required Plane
Set oDirection = hybShape.AddNewDirectionByCoord(0, 0, 1)
Set oDirection2 = hybShape.AddNewDirectionByCoord(1, 0, 0)
Set point1 = hybShape.AddNewPointCoord(5, 5, 0) 'Ceate point with required co-ordinates
Set point2 = hybShape.AddNewPointCoord(0, 5, 0)

hyBBody.AppendHybridShape point1
myPart.UpdateObject point1

Set oToolingDirection = hybShape.AddNewLinePtDir(point1, oDirection, 10, 30, False) 'Creating Tooling Direction

hyBBody.AppendHybridShape oToolingDirection
myPart.UpdateObject oToolingDirection

Set oSliderDirection = hybShape.AddNewLinePtDir(point2, oDirection2, 10, 30, False) 'Creating Slider Direction

hyBBody.AppendHybridShape oSliderDirection

myPart.UpdateObject oSliderDirection

myPart.Update

'Step3
Dim xdir As Double
Dim ydir As Double
ydir = 0
Dim zdir As Double

Dim i As Integer
For i = 1 To 1
Dim value1 As Double
value1 = i * 0
Dim value2 As Double
value2 = i + ydir + 9
Dim value3 As Double
value3 = i * 0
Dim opoint1 As HybridShapePointCoord
Set opoint1 = hybShape.AddNewPointCoord(value1, value2, value1)

hybBody2.AppendHybridShape opoint1
myPart.UpdateObject opoint1

Dim opoint2 As HybridShapePointCoord
Set opoint2 = hybShape.AddNewPointCoord(value2, value2, value3)

hybBody2.AppendHybridShape opoint2
myPart.UpdateObject opoint2

Dim opoint3 As HybridShapePointCoord
Set opoint3 = hybShape.AddNewPointCoord(value2, value1, value1)

hybBody2.AppendHybridShape opoint3
myPart.UpdateObject opoint3

Dim opoint4 As HybridShapePointCoord
Set opoint4 = hybShape.AddNewPointCoord(value1, value1, value1)

hybBody2.AppendHybridShape opoint4
myPart.UpdateObject opoint4

Next
'Creating lines
myPart.Update

Dim oLine1 As Line
Set oLine1 = hybShape.AddNewLinePtPt(opoint4, opoint1)

hybBody2.AppendHybridShape oLine1

myPart.UpdateObject oLine1

Dim oLine2 As Line
Set oLine2 = hybShape.AddNewLinePtPt(opoint1, opoint2)

hybBody2.AppendHybridShape oLine2

myPart.UpdateObject oLine2

Dim oLine3 As Line
Set oLine3 = hybShape.AddNewLinePtPt(opoint2, opoint3)

hybBody2.AppendHybridShape oLine3

myPart.UpdateObject oLine3

Dim oLine4 As Line
Set oLine4 = hybShape.AddNewLinePtPt(opoint3, opoint4)

hybBody2.AppendHybridShape oLine4

myPart.UpdateObject oLine4

myPart.Update

'Step4
Dim oJoin As HybridShapeAssemble
Set oJoin = hybShape.AddNewJoin(oLine1, oLine2)

Dim hybShapes As HybridShapes
Set hybShapes = hybBody2.HybridShapes

Dim line1 As HybridShapeLinePtPt
Set line1 = hybShapes.Item("Line.5")

Dim line2 As HybridShapeLinePtPt
Set line2 = hybShapes.Item("Line.6")

Dim reference1 As Reference
Set reference1 = myPart.CreateReferenceFromObject(line1)

oJoin.AddElement reference1

Dim reference2 As Reference
Set reference2 = myPart.CreateReferenceFromObject(line2)

oJoin.AddElement reference2

oJoin.SetConnex True

oJoin.SetManifold True

oJoin.SetSimplify False

oJoin.SetSuppressMode False

oJoin.SetDeviation 0.05

oJoin.SetAngularToleranceMode False

oJoin.SetAngularTolerance 0.5

oJoin.SetFederationPropagation 0

hybBody2.AppendHybridShape oJoin

myPart.UpdateObject oJoin

myPart.Update

'Step5
Dim shapefactory As shapefactory 'invoke shapefactory
Set shapefactory = myPart.shapefactory

Dim refeence3 As Reference
Set refeence3 = myPart.CreateReferenceFromObject(oJoin) 'Create reference from join to input as sketch for pad

Dim oPad As Pad
Set oPad = shapefactory.AddNewPadFromRef(refeence3, -20)

myPart.Update

'Step6
Dim partDocument2 As Documents
Set partDocument2 = CATIA.ActiveDocument.Part

Dim part1 As Part
'Set part1 = partDocument2.Part
Set part1 = myPart

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.shapefactory

Dim reference4 As Reference
Set reference4 = part1.CreateReferenceFromName("")

Dim Draft1 As Draft
Set Draft1 = shapefactory.AddNewDraft(reference4, reference4, catNoneDraftNeutralPropagationMode, reference4, 0, 0, 1, catStandardDraftMode, 3, catNoneDraftMultiselectionMode)

Dim draftDomain1 As DraftDomains
Set draftDomain1 = Draft1.DraftDomains

Dim draftDomain2 As DraftDomain
Set draftDomain2 = draftDomain1.Item(1)

draftDomain2.SetPullingDirection 0, 0, 1

Dim bodies1 As Bodies
Set bodies1 = myPart.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("Body.2")


Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection
Dim Filter(0) 'ERROR HERE
Filter(0) = "Face"
Dim fBody As String
fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)

Dim reference5 As Reference
Set reference5 = oSel.Item(1).Value

draftDomain2.AddFaceToDraft reference5
draftDomain2.SetPullingDirection 0, 0, 1

oSel.Clear

fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)
Dim reference6 As Reference
Set reference6 = oSel.Item(1).Value

draftDomain2.PullingDirectionElement = reference6

fBody = oSel.SelectElement2(Filter, " Select Body in which you want to add", False)
Dim reference7 As Reference
Set reference7 = oSel.Item(1).Value

draftDomain2.NeutralElement = reference7

myPart.Update

Dim partDocument1 As partDocument
Set partDocument1 = CATIA.ActiveDocument
partDocument1.SaveAs "C:\Users\Me\Desktop\New folder (2)\Doghouse.CATPart" 'Save the Document



myPart.Update

End Sub

'Private Sub Thickness_Change()

'End Sub

Check my website for more cool macros [link catiavbmacro.com]catiavbmacro.com[/url]