- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I need to create by VBA code a rectangular pattern allineated to a line in the sketch.
I'm not able to use the line as direction.
Can anybody help me to solve the problem?
This is a sample code.
Thank in advance
Public Sub RectPatternWithDirectionBySketchLine()
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
' Set a reference to the component definition.
Dim oCompDef As PartComponentDefinition
Set oCompDef = oPartDoc.ComponentDefinition
' Create a new sketch on the X-Y work plane.
Dim oSketch As PlanarSketch
Set oSketch = oCompDef.Sketches.Add(oCompDef.WorkPlanes(3))
' Set a reference to the transient geometry object.
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry
' Draw a 4cm x 3cm rectangle with the corner at (0,0)
Dim oRectangleLines As SketchEntitiesEnumerator
Set oRectangleLines = oSketch.SketchLines.AddAsTwoPointRectangle(oTransGeom.CreatePoint2d(0, 0), oTransGeom.CreatePoint2d(4, 3))
' Create a profile.
Dim oProfile As Profile
Set oProfile = oSketch.Profiles.AddForSolid
' Create a base extrusion 1cm thick.
Dim oExtrudeDef As ExtrudeDefinition
Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kJoinOperation)
Call oExtrudeDef.SetDistanceExtent(1, kNegativeExtentDirection)
Dim oExtrude1 As ExtrudeFeature
Set oExtrude1 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
' Get the top face of the extrusion to use for creating the new sketch.
Dim oFrontFace As Face
Set oFrontFace = oExtrude1.StartFaces.Item(1)
' Create a new sketch on this face, but use the method that allows you to
' control the orientation and orgin of the new sketch.
Set oSketch = oCompDef.Sketches.Add(oFrontFace)
'Create and define center of circle
Dim oCoord1 As Point2d
Set oCoord1 = oTransGeom.CreatePoint2d(1, 1)
Dim oCircle As SketchCircle
Set oCircle = oSketch.SketchCircles.AddByCenterRadius(oCoord1, 0.2)
'Create line for pattern direction
Dim oCoord2 As Point2d
Dim oLine As SketchLine
Set oCoord2 = oTransGeom.CreatePoint2d(3, 2)
Set oLine = oSketch.SketchLines.AddByTwoPoints(oCoord1, oCoord2)
'Create and define Profile for extrusion
Set oProfile = oSketch.Profiles.AddForSolid
'Create cut extrusion
Set oExtrudeDef = oCompDef.Features.ExtrudeFeatures.CreateExtrudeDefinition(oProfile, kCutOperation)
Call oExtrudeDef.SetThroughAllExtent(kNegativeExtentDirection)
Dim oExtrude2 As ExtrudeFeature
Set oExtrude2 = oCompDef.Features.ExtrudeFeatures.Add(oExtrudeDef)
'Create rectangular pattern
Dim objColl As ObjectCollection
Dim oRectPatternDef As RectangularPatternFeatureDefinition
Dim oRectPattern As RectangularPatternFeature
Set objColl = ThisApplication.TransientObjects.CreateObjectCollection
Call objColl.Add(oExtrude2)
'Create rectangular pattern with X Axis direction
' /// Set oRectPatternDef = oCompDef.Features.RectangularPatternFeatures.CreateDefinition(objColl, oCompDef.WorkAxes(1), True, 5, 0.5)
' ////Set oRectPattern = oCompDef.Features.RectangularPatternFeatures.AddByDefinition(oRectPatternDef)
'Create rectangular pattern with sketch line direction
Dim OLineDirection As GeometryIntent
Set OLineDirection = oCompDef.CreateGeometryIntent(oLine)
Set oRectPatternDef = oCompDef.Features.RectangularPatternFeatures.CreateDefinition(objColl, OLineDirection, True, 5, 0.5)
Set oRectPattern = oCompDef.Features.RectangularPatternFeatures.AddByDefinition(oRectPatternDef)
End Sub
Solved! Go to Solution.