Community

Get an error on creating the profile (VBA)

Get an error on creating the profile (VBA)

Anonymous
Not applicable
357 Views
3 Replies
Message 1 of 4

Get an error on creating the profile (VBA)

Anonymous
Not applicable
‎06-11-2021 04:47 AM

I try to use this sketch to create the Extrudefeature but get an error on creating the profile.  I have attached the file to this post.

I appreciate any help!

 

 

 

 

Practice1.zip
0 Likes
Like
Report
358 Views
3 Replies
Tags
Replies (3)
Message 2 of 4

FINET_Laurent
Advisor
Advisor
‎06-12-2021 01:37 AM

Can you post the code instead ?

 

Regards,

 

FINET L.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn     @JohnCockerill

0 Likes
Like
Report
Message 3 of 4

Anonymous
Not applicable
in reply to FINET_Laurent
‎06-14-2021 11:09 AM

Public Sub STR0003()
Dim oApp As Inventor.Application
Set oApp = ThisApplication

Dim oPartDoc As PartDocument
Set oPartDoc = oApp.Documents.Add(kPartDocumentObject, oApp.FileManager.GetTemplateFile(kPartDocumentObject))
Dim oSketch(1 To 😎 As PlanarSketch
Set oSketch(1) = oPartDoc.ComponentDefinition.Sketches.Add(oPartDoc.ComponentDefinition.workPlanes.item(2))
Dim oTG As TransientGeometry
Set oTG = oApp.TransientGeometry
Dim oSkPnts As SketchPoints
Set oSkPnts = oSketch(1).SketchPoints
Call oSkPnts.Add(oTG.CreatePoint2d(0, 0), False) 'oSkPnts(1) 1
Call oSkPnts.Add(oTG.CreatePoint2d(0, 1.5 * 2.54), False) 'oSkPnts(2)2

Call oSkPnts.Add(oTG.CreatePoint2d(-10 * 2.54, 1.5 * 2.54), False) 'oSkPnts(7)3
Call oSkPnts.Add(oTG.CreatePoint2d(-10 * 2.54, 0), False) 'oSkPnts(8)4


Call oSkPnts.Add(oTG.CreatePoint2d(-0.10608028 * 2.54, 1.5 * 2.54), False) 'oSkPnts(11) right high 5
Call oSkPnts.Add(oTG.CreatePoint2d(-0.1841075 * 2.54, 1.43765652 * 2.54), False) 'oSkPnts(12) right high 6
Call oSkPnts.Add(oTG.CreatePoint2d(-0.10608028 * 2.54, 1.42 * 2.54), False) 'oSkPnts(13) center of right high 7


Call oSkPnts.Add(oTG.CreatePoint2d(-0.42916783 * 2.54, 0.35469256 * 2.54), False) 'oSkPnts(14) right low 8
Call oSkPnts.Add(oTG.CreatePoint2d(-0.66032347 * 2.54, 0.17 * 2.54), False) 'oSkPnts(15) right low 9
Call oSkPnts.Add(oTG.CreatePoint2d(-0.66032347 * 2.54, 0.407 * 2.54), False) 'oSkPnts(16) center of right low 10

Call oSkPnts.Add(oTG.CreatePoint2d(-9.89391972 * 2.54, 1.5 * 2.54), False) 'oSkPnts(17) left high 11
Call oSkPnts.Add(oTG.CreatePoint2d(-9.8158925 * 2.54, 1.43765652 * 2.54), False) 'oSkPnts(18) left high 12
Call oSkPnts.Add(oTG.CreatePoint2d(-9.89391972 * 2.54, 1.42 * 2.54), False) 'oSkPnts(19) center of left high 13

Call oSkPnts.Add(oTG.CreatePoint2d(-9.57083217 * 2.54, 0.35469256 * 2.54), False) 'oSkPnts(20) left high 14
Call oSkPnts.Add(oTG.CreatePoint2d(-9.33967653 * 2.54, 0.17 * 2.54), False) 'oSkPnts(21) left high 15
Call oSkPnts.Add(oTG.CreatePoint2d(-9.33967653 * 2.54, 0.407 * 2.54), False) 'oSkPnts(22) center of left high 16

 


Dim oLines As SketchLines
Set oLines = oSketch(1).SketchLines
Dim oLine(1 To 30) As SketchLine
Set oLine(1) = oLines.AddByTwoPoints(oSkPnts(1), oSkPnts(2)) 'Body
Set oLine(2) = oLines.AddByTwoPoints(oSkPnts(2), oSkPnts(5)) 'Body
Set oLine(3) = oLines.AddByTwoPoints(oSkPnts(6), oSkPnts(8)) 'Body
Set oLine(4) = oLines.AddByTwoPoints(oSkPnts(9), oSkPnts(15)) 'Body
Set oLine(5) = oLines.AddByTwoPoints(oSkPnts(14), oSkPnts(12)) 'Body
Set oLine(6) = oLines.AddByTwoPoints(oSkPnts(11), oSkPnts(3)) 'Body
Set oLine(7) = oLines.AddByTwoPoints(oSkPnts(3), oSkPnts(4)) 'Body
Set oLine(8) = oLines.AddByTwoPoints(oSkPnts(4), oSkPnts(1)) 'Body


Dim oArcs As SketchArcs
Set oArcs = oSketch(1).SketchArcs
Dim oArc(1 To 😎 As SketchArc
Set oArc(1) = oArcs.AddByCenterStartEndPoint(oSkPnts(7), oSkPnts(5), oSkPnts(6))
Set oArc(2) = oArcs.AddByCenterStartEndPoint(oSkPnts(10), oSkPnts(9), oSkPnts(8))
Set oArc(3) = oArcs.AddByCenterStartEndPoint(oSkPnts(16), oSkPnts(14), oSkPnts(15))
Set oArc(4) = oArcs.AddByCenterStartEndPoint(oSkPnts(13), oSkPnts(12), oSkPnts(11))

 

Dim oProfile(1 To 😎 As profile

Set oProfile(1) = oSketch(1).Profiles.AddForSolid
End Sub

0 Likes
Like
Report
Message 4 of 4

Anonymous
Not applicable
‎06-16-2021 12:30 PM

Public Sub STR0003() Dim oApp As Inventor.Application Set oApp = ThisApplication Dim oPartDoc As PartDocument Set oPartDoc = oApp.Documents.Add(kPartDocumentObject, oApp.FileManager.GetTemplateFile(kPartDocumentObject)) Dim oSketch(1 To 😎 As PlanarSketch Set oSketch(1) = oPartDoc.ComponentDefinition.Sketches.Add(oPartDoc.ComponentDefinition.workPlanes.item(2)) Dim oTG As TransientGeometry Set oTG = oApp.TransientGeometry Dim oSkPnts As SketchPoints Set oSkPnts = oSketch(1).SketchPoints Call oSkPnts.Add(oTG.CreatePoint2d(0, 0), False) 'oSkPnts(1) 1 Call oSkPnts.Add(oTG.CreatePoint2d(0, 1.5 * 2.54), False) 'oSkPnts(2)2 Call oSkPnts.Add(oTG.CreatePoint2d(-10 * 2.54, 1.5 * 2.54), False) 'oSkPnts(7)3 Call oSkPnts.Add(oTG.CreatePoint2d(-10 * 2.54, 0), False) 'oSkPnts(8)4 Call oSkPnts.Add(oTG.CreatePoint2d(-0.10608028 * 2.54, 1.5 * 2.54), False) 'oSkPnts(11) right high 5 Call oSkPnts.Add(oTG.CreatePoint2d(-0.1841075 * 2.54, 1.43765652 * 2.54), False) 'oSkPnts(12) right high 6 Call oSkPnts.Add(oTG.CreatePoint2d(-0.10608028 * 2.54, 1.42 * 2.54), False) 'oSkPnts(13) center of right high 7 Call oSkPnts.Add(oTG.CreatePoint2d(-0.42916783 * 2.54, 0.35469256 * 2.54), False) 'oSkPnts(14) right low 8 Call oSkPnts.Add(oTG.CreatePoint2d(-0.66032347 * 2.54, 0.17 * 2.54), False) 'oSkPnts(15) right low 9 Call oSkPnts.Add(oTG.CreatePoint2d(-0.66032347 * 2.54, 0.407 * 2.54), False) 'oSkPnts(16) center of right low 10 Call oSkPnts.Add(oTG.CreatePoint2d(-9.89391972 * 2.54, 1.5 * 2.54), False) 'oSkPnts(17) left high 11 Call oSkPnts.Add(oTG.CreatePoint2d(-9.8158925 * 2.54, 1.43765652 * 2.54), False) 'oSkPnts(18) left high 12 Call oSkPnts.Add(oTG.CreatePoint2d(-9.89391972 * 2.54, 1.42 * 2.54), False) 'oSkPnts(19) center of left high 13 Call oSkPnts.Add(oTG.CreatePoint2d(-9.57083217 * 2.54, 0.35469256 * 2.54), False) 'oSkPnts(20) left high 14 Call oSkPnts.Add(oTG.CreatePoint2d(-9.33967653 * 2.54, 0.17 * 2.54), False) 'oSkPnts(21) left high 15 Call oSkPnts.Add(oTG.CreatePoint2d(-9.33967653 * 2.54, 0.407 * 2.54), False) 'oSkPnts(22) center of left high 16 Dim oLines As SketchLines Set oLines = oSketch(1).SketchLines Dim oLine(1 To 30) As SketchLine Set oLine(1) = oLines.AddByTwoPoints(oSkPnts(1), oSkPnts(2)) 'Body Set oLine(2) = oLines.AddByTwoPoints(oSkPnts(2), oSkPnts(5)) 'Body Set oLine(3) = oLines.AddByTwoPoints(oSkPnts(6), oSkPnts(8)) 'Body Set oLine(4) = oLines.AddByTwoPoints(oSkPnts(9), oSkPnts(15)) 'Body Set oLine(5) = oLines.AddByTwoPoints(oSkPnts(14), oSkPnts(12)) 'Body Set oLine(6) = oLines.AddByTwoPoints(oSkPnts(11), oSkPnts(3)) 'Body Set oLine(7) = oLines.AddByTwoPoints(oSkPnts(3), oSkPnts(4)) 'Body Set oLine(8) = oLines.AddByTwoPoints(oSkPnts(4), oSkPnts(1)) 'Body Dim oArcs As SketchArcs Set oArcs = oSketch(1).SketchArcs Dim oArc(1 To 😎 As SketchArc Set oArc(1) = oArcs.AddByCenterStartEndPoint(oSkPnts(7), oSkPnts(5), oSkPnts(6)) Set oArc(2) = oArcs.AddByCenterStartEndPoint(oSkPnts(10), oSkPnts(9), oSkPnts(8)) Set oArc(3) = oArcs.AddByCenterStartEndPoint(oSkPnts(16), oSkPnts(14), oSkPnts(15)) Set oArc(4) = oArcs.AddByCenterStartEndPoint(oSkPnts(13), oSkPnts(12), oSkPnts(11)) Dim oProfile(1 To 😎 As profile Set oProfile(1) = oSketch(1).Profiles.AddForSolid End Sub

0 Likes
Like
Report
Report a website issue