CADForums.net

GerardK · Guest

Hello all,

When running this code, autocad (2004) gives me a Execution error.
This error comes from "For Each objAcadEntity In objSSet, next".
How can I solve this problem??

Newby on VBA,
Gerard

'Public Sub MakeHatchesFromLayer(myLayerName As String)
Dim arrOuterLoop(0) As AcadEntity
Dim objAcadHatch As AcadHatch
Dim objSSet As AcadSelectionSet
Dim objAcadEntity As AcadEntity
Dim gpCode(0 To 1) As Integer
Dim gpValue(0 To 1) As Variant

On Error GoTo ErrMakeHatchesFromLayer:

Set objSSet = ThisDrawing.SelectionSets.Add("SSet_MakeHatches")

gpCode(0) = 8: gpValue(0) = myLayerName
gpCode(1) = 0: gpValue(1) = "LWPOLYLINE"
objSSet.Select acSelectionSetAll, , , gpCode, gpValue

For Each objAcadEntity In objSSet ''''''''''ERROR why ??
If objAcadEntity.Closed Then
Set arrOuterLoop(0) = objAcadEntity
Set objAcadHatch = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)

objHatch.AppendOuterLoop objPline

objAcadHatch.AppendOuterLoop arrOuterLoop
objAcadHatch.Evaluate
objAcadHatch.Layer = myLayerName
End If
Next

ExitErrMakeHatchesFromLayer:
objSSet.Delete
Exit Sub

ErrMakeHatchesFromLayer:

MsgBox "Error : " & Err.Number & " - " & Err.Description
GoTo ExitErrMakeHatchesFromLayer:
End Sub

Ed Jobe · Guest

You didn't say what the error was, but...Are you sure your filter is working
properly and that it returns only lwp's? You also should have gotten a
compile error with objAcadEntity.Closed since that object type doesn't
support that method. You either need to dim the var as type AcadLWPolyline
or use the following structure if you don't know what type of ents are in
the ss:

Dim LWP As AcadLwPolyline
For Each objAcadEntity In objSSet
If TypeOf objAcadEntity Is AcadLwPolyline Then
Set objLWP = objAcadEntity
If objLWP.Closed Then

If you know that the ss will always contain only lwp's then:

Dim LWP As AcadLwPolyline
For Each objLWP In objSSet
If objLWP.Closed Then

--
----
Ed
----

Nathan Taylor · Guest

"You also should have gotten a compile error with objAcadEntity.Closed since that object type doesn't support that method."
If you declare an object as an AcadEntity it will support all methods that the object has. So the line will not cause an error but certainly as all is being selected are LWPolylines the variable should be declared as an AcadLWPolyline.
Regards - Nathan

GerardK · Guest

Ed,

Thanks for your reply and help.
Your right.
It must be AcadLwPolyline.

But....................again the same error.

Command: -vbarun
Macro name: Module1.MakeHatchesFromLayer Execution error

(I also tryed "Unload me".)

In the .DVB I have several routines, forms and modules.
(works fine, without troubles)

I use module1 to test this VBa routine.
Nothing else is on module module1.

I use the following module to start this macro.

Function MyPullDownMenu()
Dim MyMenu As New ClsAcadMenu
GetAcadDrive

MyMenu.GroupName = "GK"
MyMenu.MakeMenuGroup GKMenuGroup

MyMenu.MenuName = "GK"
MyMenu.MakeMenuGroup GKMenu

MyMenu.MenuItemName = "Plot"
MyMenu.Macro = "-vbarun ModPlot.plot1 "
MyMenu.MakeMenuGroup GKMenuItem

MyMenu.MenuItemName = "RAL kleuren"
MyMenu.Macro = "-vbarun RAL.HatchColor "
MyMenu.MakeMenuGroup GKMenuItem

MyMenu.MenuItemName = "Opmerkingen toevoegen"
MyMenu.Macro = "-vbarun Tools.Notes "
MyMenu.MakeMenuGroup GKMenuItem

MyMenu.MenuItemName = "Test"
MyMenu.Macro = "-vbarun Module1.MakeHatchesFromLayer "
MyMenu.MakeMenuGroup GKMenuItem

ect.

MyMenu.ToolBarName = "GK"
MyMenu.MakeMenuGroup GKToolBar

MyMenu.BitmapName = PadBlocks & "Formulier.bmp"
MyMenu.MakeMenuGroup GKToolBarItem
End Function

(Menu works fine)

But, What do I wrong ??

GerardK · Guest

Nathan,

Thanks for your reply and help.
Your right.
It must be AcadLwPolyline.

But....................again the same error.

Command: -vbarun
Macro name: Module1.MakeHatchesFromLayer Execution error

please see the reply I given to Ed.

Ed Jobe · Guest

Execution Error only tells you that your macro failed to fully complete. If
its not breaking into the debugger like Robert mentioned, set a breakpoint
at the beginning of the sub and hit F5 to run the macro. It will stop at the
line where you added the breakpoint and you can step through the code one
line at a time and see exactly where it's failing. Hint: turn on the Debug
toolbar. The Step Into button will step into even other subs you call. The
Step Over button can pass it over if you know that sub is good.

--
----
Ed
----
"GerardK" <nospam@address.withheld> wrote in message
news:11762846.1105089976262.JavaMail.jive@jiveforum1.autodesk.com...

GerardK · Guest

Hello Ed,
And every one who's helping,

Some problems are solved. (I renamed the routine to test)
The reason for the Execution error was the first line.
Sub test(myLayerName As String)

After changing it to

Sub test()
Dim myLayerName As String

The Execution error was gone. Why ???? (It works)

Now running the program.

I can create in acad a closed polyline on two ways.
Point to point to point to endpoint or ... point to point to point and close.

In both cases there is a closed figure.

But.... This routine detect only closed polylines ONLY when the figures are closed by the letter "C" (To endpoint doesn't work!)
Why ?? Is close not close ??

After detection all the closed polylines, the system returns with error 424; object required.

Sub test()
Dim myLayerName As String
Dim arrOuterLoop(0) As AcadLWPolyline 'AcadEntity
Dim objAcadHatch As AcadHatch
Dim objSSet As AcadSelectionSet
Dim objAcadEntity As AcadEntity
Dim gpCode(0 To 1) As Integer
Dim gpValue(0 To 1) As Variant
Dim LWP As AcadLWPolyline

On Error GoTo ErrMakeHatchesFromLayer:

Set objSSet = ThisDrawing.SelectionSets.Add("SSet_MakeHatches")

gpCode(0) = 8: gpValue(0) = "0" 'myLayerName
gpCode(1) = 0: gpValue(1) = "LWPOLYLINE"
objSSet.Select acSelectionSetAll, , , gpCode, gpValue

For Each objLWP In objSSet
If objLWP.Closed Then
arrOuterLoop(0) = objAcadEntity
objAcadHatch = ThisDrawing.ModelSpace.AddHatch(acHatchPatternTypePreDefined, "SOLID", True)

objHatch.AppendOuterLoop objPline

objAcadHatch.AppendOuterLoop arrOuterLoop
objAcadHatch.Evaluate
objAcadHatch.Layer = "HATCH" 'myLayerName
End If
Next

ExitErrMakeHatchesFromLayer:
objSSet.Delete
Exit Sub

ErrMakeHatchesFromLayer:
MsgBox "Error : " & Err.Number & " - " & Err.Description

GoTo ExitErrMakeHatchesFromLayer:
End Sub

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

Most of the time I changed the program (for try out) , I get the error "The named section set exists".
I'm restarting acad, undo the changes or modify the changes and this problem is solved (Til the next time).
Is there a more easy way to solve this, without restarting acad ??

Gerard

Ed Jobe · Guest

I don't have time at the moment to research your other problems, but I can
answer your first question.
Its because you can't directly run a sub that has arguments. They have to be
called by other subs.

--
----
Ed
----
"GerardK" <nospam@address.withheld> wrote in message
news:13236699.1105135101727.JavaMail.jive@jiveforum2.autodesk.com...

R. Robert Bell · Guest

"GerardK" <nospam@address.withheld> wrote in message
news:13236699.1105135101727.JavaMail.jive@jiveforum2.autodesk.com...
....
But.... This routine detect only closed polylines ONLY when the figures are
closed by the letter "C" (To endpoint doesn't work!)
Why ?? Is close not close ??
....

Not from the perspective of the Closed property.

GerardK · Guest

R. Robert Bell · Guest

Examine each LWPoly in your selection set and examine the beginning and
ending coordinates if the Closed property is False. If the coordinates
match, then hatch.

--
R. Robert Bell

"GerardK" <nospam@address.withheld> wrote in message
news:21427598.1105200593646.JavaMail.jive@jiveforum2.autodesk.com...

	CADForums.net Forum Index -> VBA	All times are GMT
Page 1 of 1