RE: VBA Problem - Need Help

[Anonymous]

As attached picture shown, some workplanes intersect with a solid body, I need to extract the intersecting profiles (cutting edges - in this example they are different sizes of circles), and save these sketches (circles) as separate dxf files by using VBA macro automatically.

Is it possible to solve this problem by Inventor VBA? (The solid body is a Inventor part file)

Thank you in advance.

[Anonymous]

Hi,

Here is the solution for creating the intersection curve between planes & solid body. With the code below you can get a sketch, but donno whether Inventor API are open for exporting the sketches.

This code will surve half of your purpose..


Sub SketchExport()

Dim Doc As PartDocument
Dim WPs As WorkPlanes
Dim WP As WorkPlane
Dim Sk As PlanarSketch
Dim CommandMgr As CommandManager
Dim ControlDef As ControlDefinition

Set Doc = ThisApplication.ActiveDocument
Set WPs = Doc.ComponentDefinition.WorkPlanes
Set CommandMgr = ThisApplication.CommandManager
Set ControlDef = CommandMgr.ControlDefinitions.Item("SketchProjectCutEdgesCmd")
For i = 4 To WPs.Count
Set WP = WPs.Item(i)
Set Sk = Doc.ComponentDefinition.Sketches.Add(WP, False)
Sk.Edit
Call ControlDef.Execute
Sk.ExitEdit
Set WP = Nothing
Set Sk = Nothing
Next
Set Doc = Nothing
Set WPs = Nothing
End Sub

[Anonymous]

Here is an adapted version of Digvijay's sample that also outputs the DXF
files from sketches. Note that I'm using the formal APIs for the 'projected
cut' functionality introduced in Inventor 2010. If you are on previous
releases, you'll need to use Digvijay's wokaround of executing the
corresponding ControlDefinition.

Sanjay-


Sub SketchExport()

Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oDef As PartComponentDefinition
Set oDef = oDoc.ComponentDefinition

Dim oWP As WorkPlane
Dim i As Long
For i = 4 To oDef.WorkPlanes.count
Set oWP = oDef.WorkPlanes.Item(i)

Dim oSketch As PlanarSketch
Set oSketch = oDef.Sketches.Add(oWP, False)

oSketch.ProjectedCuts.Add
Call oSketch.DataIO.WriteDataToFile("DXF", "C:\temp\" & oSketch.Name
& ".dxf")

Next

End Sub

[Anonymous]

Thank you so much for your help.

[Anonymous]

Thank you Sanjay for your great help.

[Anonymous]

Sanjay,

I'm having trouble getting your code for exporting to DXF to work. When I run the code, it goes through with out an error, but it doesn't generate any DXF file.

Also, I'm using Inventor 2010 Pro SP0, and there is no osketch.ProjectCuts.Add method available to me.

Finally, If you have a work plane that doesn't intersect any geometry it throw up an error message in Inventor, but "On Error Resume Next" doesn't allow the code to ignore the message, because it's not a VBA error. What can you do to get around this?

Thanks in Advance.

Regards

=======================================================================

Sub exportsectiontest()

'set definitions for expressions
Dim oDoc As PartDocument
Dim oComponent As Object
Dim oSketch As Sketch
Dim oLine As SketchLine
Dim CommandMgr As CommandManager
Dim ControlDef As ControlDefinition

Set oDoc = ThisApplication.ActiveDocument 'define document

Set oComponent = oDoc.ComponentDefinitions.Item(1) 'define component
Set CommandMgr = ThisApplication.CommandManager
Set ControlDef = CommandMgr.ControlDefinitions.Item("SketchProjectCutEdgesCmd")

'On Error Resume Next

For i = 1 To oComponent.WorkPlanes.Count
Set oWorkPlane = oComponent.WorkPlanes.Item(i)
Set oSketch = oComponent.Sketches.Add(oWorkPlane, True)
Set CommandMgr = ThisApplication.CommandManager

oSketch.Edit
Call ControlDef.Execute
oSketch.ExitEdit
Call oSketch.DataIO.WriteDataToFile("dxf", "c:\temp" & oSketch.Name & ".dxf")
Next

End Sub

[Anonymous]

Hi Sanjay,

Do you have any comments on Hickoz's reply?

I use inventor 2009 right now, I have not tried the code yet.

Thank you.

[Anonymous]

I added the 'On Error Resume Next' line of code to account for
non-intersecting workplanes (see below). I tried the code on Inventor 2010
and it works just fine. I also checked the VBA object browser and see the
PlanarSketch.ProjectedCuts interface.

Sanjay-


Sub SketchExport()

Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument

Dim oDef As PartComponentDefinition
Set oDef = oDoc.ComponentDefinition

Dim oWP As WorkPlane
Dim i As Long
For i = 4 To oDef.WorkPlanes.Count
Set oWP = oDef.WorkPlanes.Item(i)

On Error Resume Next
Dim oSketch As PlanarSketch
Set oSketch = oDef.Sketches.Add(oWP, False)

oSketch.ProjectedCuts.Add
Call oSketch.DataIO.WriteDataToFile("DXF", "C:\temp\" & oSketch.Name
& ".dxf")

Next

End Sub

[Anonymous]

Hickoz,

I tried your code in Inventor 2009 VBA, it works. But it's not stable, I mean sometimes it generates cut edge sketches perfectly, sometimes nothing, just empty dxf files. Also sometimes only comes with part of the skecthes (not full cutting sketches, some lines or curves missing). I added two lines in your code, it becomes better for generating part of the sketches.
But there is still a problem for sometimes not generating cutting sketches at all?

Sanjay, do you have any idea for this problem?

Thank you.

=======================================================================

Sub exportsectiontest()

'set definitions for expressions
Dim oDoc As PartDocument
Dim oComponent As Object
Dim oSketch As Sketch
Dim oLine As SketchLine
Dim CommandMgr As CommandManager
Dim ControlDef As ControlDefinition

Set oDoc = ThisApplication.ActiveDocument 'define document

Set oComponent = oDoc.ComponentDefinitions.Item(1) 'define component
Set CommandMgr = ThisApplication.CommandManager
Set ControlDef = CommandMgr.ControlDefinitions.Item("SketchProjectCutEdgesCmd")

'On Error Resume Next

For i = 1 To oComponent.WorkPlanes.Count
Set oWorkPlane = oComponent.WorkPlanes.Item(i)
Set oSketch = oComponent.Sketches.Add(oWorkPlane, True)
Set CommandMgr = ThisApplication.CommandManager

oSketch.Edit
ThisApplication.SilentOperation = True
Call ControlDef.Execute
ThisApplication.SilentOperation = False
oSketch.ExitEdit
Call oSketch.DataIO.WriteDataToFile("dxf", "c:\temp" & oSketch.Name & ".dxf")
Next

End Sub

[Anonymous]

Call oSketch.DataIO.WriteDataToFile("dxf", "c:\temp" & oSketch.Name & ".dxf")

How to save the dxf file as the lower version? such as AutoCAD R12 or AutoCAD 2000.

I am running VBA in Inventor 2010, I want to add options in VBA to save DXF files as different versions.

Thanks.