extract boundary of hatch

extract boundary of hatch

Anonymous
Not applicable
3,588 Views
34 Replies
Message 1 of 35

extract boundary of hatch

Anonymous
Not applicable
ive found an autolisp to extract the boundary of a hatch

http://www.spaug.org/Public_Files/AutoLISP/HatchB.Zip

but in VBA it cant be done if boundary was deleted

hatchObj.GetLoopAt J, loopObjs

this only works with existing objects used as loops/boundary

so, is there any way to extract DXF codes/lists of an object and work in VBA with them?

i dont want to work with LISP, is a very extrange language for me
0 Likes
3,589 Views
34 Replies
Replies (34)
Message 2 of 35

Anonymous
Not applicable
Ok. this is what I have done to do this:

I use regular expressions to separate the DXF entities, but any way would work. If you see right, I am first taking the DXF text block and converting it to an XML document. This allows for better reading of the codes.

Use the Ci_Hatch object, witch uses the other classes. The Read() method will allow you to extract Hatch information. You simply need to give it the UNASSOCIATIVE HATCH and the DXF block as parameter. Then use the CreateBoundaries method to recreate these "lost" boundaries.


Please, also: I have spent many weeks working on these classes (the ReadBoundaries method in particular). Please respect my signature on top and make sure these credits stay there. Its just basic "savoir-vivre"!

Tanks, and I hope this helps!!
0 Likes
Message 3 of 35

Anonymous
Not applicable
Nyme,

A very impressive bit of coding in these class modules.

But I need a better translation of "savoir-vivre" which I think
means "know how to live" or "enjoy life" ?

Maximo
0 Likes
Message 4 of 35

Anonymous
Not applicable
LOL

First one. its...... Know how to live is the literal translation, but its close enought.

Over all, "savoir-vivre" is an expression that means "having basic manners"....

And tanks for the compliment. 1 problem!!! I think there is some french comments in there.... hope its not to big of a problem!
0 Likes
Message 5 of 35

Anonymous
Not applicable
Apparently no french comments..... youll be good!! 😉
0 Likes
Message 6 of 35

Anonymous
Not applicable
For the block splitting, well, here is the solution.

Use a RegEx object and use this pattern (on one line).

\n\s\s0\r\n((HATCH)[A-Z\d]*)\r\n\s\s5\r\n([\dA-F]*)(.*[\r\n](?! 10))*330\r\n([\dA-F]*)(.*[\r\n](?! 10))*((.*[\r\n](?! 0))*)

The result set will be the DXF text blocks of all your hatches in the drawing. If you then look at an individual Match, you will see that I have splited some of the important information into SubMatches (like the Handle, ...). Use these handle and the ObjectToHandle method to pin point the given hatch.

The steps would be:
1) Export your drawing to a DXF file.
2) Open the DXF file and put the text in a string variable.
3) Execute the RegularExpression on the text (set the Multiline and Global properties to True)
4) Loop trought the Matches result out
5) For each of them, take the Handle (alwaise the same SubMatch), retrive your Hatch with the HandleToObject method.
6) Give the hole DXF Match and the entity to the Read method in my classes.

and you should be set to work.!!

Let me know!
0 Likes
Message 7 of 35

Anonymous
Not applicable
gonna test your code, dont know when but ill do it

anyway, thanks a lot
0 Likes
Message 8 of 35

Anonymous
Not applicable
it needs Public COLOR As New Ci_Color
class
is not on the zip

is this the way to test the class?

Sub test()

Dim oObject As AcadEntity
Dim loopObjs As Variant
Dim objName As String
Dim HatchObj As AcadHatch
Dim ssetSeleccion As AcadSelectionSet
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
Dim COLOR As AcadAcCmColor
Dim sRuta As String
On Error GoTo ErrControl
':::::::::::::::::::::::::::::::::..
FilterType(0) = 0: FilterData(0) = "HATCH"
Set ssetSeleccion = ThisDrawing.SelectionSets.Add("Seleccion")
ThisDrawing.Utility.Prompt "Select a hatchr: " & vbCrLf
seleccionsombreados:
ssetSeleccion.SelectOnScreen FilterType, FilterData
If GetAsyncKeyState(VK_ESCAPE) Then MsgBox "Ejecucion interrumpida por el usuario.", vbExclamation, "Inner - Message": GoTo ExitHere
If Not ssetSeleccion.COUNT = 1 Then
MsgBox "Select only one object." & vbCrLf & "Or press 'escape' to abort.", vbExclamation, "Inner - Message"
GoTo seleccionsombreados
End If
':::::::::::::::::::::::::::::::::..

loopObjs = ssetSeleccion.Item(1)
sRuta = "C:\Documents and Settings\USER\Escritorio\Hatch\puntos.dxf"
Dim Ci_Hatch As New Ci_Hatch
Ci_Hatch.Read loopObjs, sRuta

End Sub
0 Likes
Message 9 of 35

Anonymous
Not applicable
yeps, me too as class-module-n00b;-)
BTW, you must do something like this in a 'normal' Module:

Option Explicit
Public hatchtest As Ci_Hatch

Sub mytest()
Set hatchtest = New Ci_Hatch
hatchtest.Create
End Sub

don't know if its right, just try it again;-)
Its also a question of the acad- and vba-version,
i've here only acad2k and there's a lot of errors to report, for instance:
customize type not defined > marked in:
Public COLOR As New Ci_Color
Looks like not defined as class, but i've really no plan with classes.

Anyway - thanks for this interesting code, ever wonder about purpose of class modules,
but now i think i should begin to try&understand it;-)
0 Likes
Message 10 of 35

Anonymous
Not applicable
ive changed part of my test code

Dim strSomeFile As String
Dim oObject As AcadEntity
strSomeFile = "C:\puntos.dxf"
Open strSomeFile For Binary As #1
Dim strBuff As String
strBuff = Space(LOF(1))
Get #1, , strBuff
Close #1
MsgBox strBuff
Set oObject = ssetSeleccion.Item(0)
Dim Ci_Hatch As New Ci_Hatch
Ci_Hatch.Read loopObjs, strBuff
0 Likes
Message 11 of 35

Anonymous
Not applicable
Dam... I fogot about the color thing. Tomorrow.....


And sorry, I have AutoCad 2005. The only things to change are all declerations that looks with IAcadxxxxx2 (Ex: IAcadBlock2). Just change them to the same, with out the "I" and the "2".


As for the "normal" module, well, NO!!! you dont do stuff like this in a normal module. You use a Module to create a macro. That macro will use an "OBJECT", witch is what a class module is.

The only other thing is that you cannot give the Read function an entire DXF file. USE THE REGULAR EXPRESSION ENGIN AND THE REGULAR EXPRESSION I GAVE YOU. You won't be able to have it read unless you give it exactly the output of this regular expression. But the rest of the exemple seen here.
0 Likes
Message 12 of 35

Anonymous
Not applicable
ok, ill use the regexp

Dim RegEx As New RegExp
'Microsoft VBScript Regular Expression type library 5.5
RegEx.IgnoreCase = True
RegEx.Global = True
RegEx.Pattern = "\n\s\s0\r\n((HATCH)[A-Z\d]*)\r\n\s\s5\r\n([\dA-F]*)(.*[\r\n](?! 10))*330\r\n([\dA-F]*)(.*[\r\n](?! 10))*((.*[\r\n](?! 0))*)"

but still need to read about extracting substrings

ill wait till tomorrow for your color class and then ill try to code a full test
0 Likes
Message 13 of 35

Anonymous
Not applicable
Dim FSO As FileSystemObject
Set FSO = New FileSystemObject
Dim DXFMatches As MatchCollection
Dim DXFMatch As Match
Dim Rexp As RegExp
Dim DXFstr As String
Dim i as Integer

DXFstr = FSO.GetFile("TheFileNameAndPath").OpenAsTextStream.ReadAll

Rexp.Global = True
Rexp.MultiLine = True
Rexp.Pattern = "************************"

Set DXFMatches = Rexp.Execute(DXFstr)
mDXFBefore.RemoveAll
mDXFBeforeID.RemoveAll
For Each DXFMatch In DXFMatches
For i = LBound(DXFMatch.SubMatches) to UBound(DXFMatch.SubMatches)

Next i
'Do whatever
Next DXFMatch




That should do the trick.
0 Likes
Message 14 of 35

Anonymous
Not applicable
wow, you writte code ala "scripters way"
this is a very interesting document i found
http://www.charteris.com/Publications/WhitePapers/Downloads/UsingTheFileSystemObjectsInVisualBasic.pdf

still need the color class
0 Likes
Message 15 of 35

Anonymous
Not applicable
Its not because it comes from the VBScriping interface that its "ala scripter's way"... I don't think so.

Are you talking about the
Dim x as FileSystemObject
Set x = New FileSystemObject

... and you think I could have done ...

Dim X as New FileSystemObject...

Is that what you mean???
0 Likes
Message 16 of 35

Anonymous
Not applicable
Sorry if I seam pissed, that's not it at all...... I'm just curious about what you mean by "ala scripter way"......

;-)
0 Likes
Message 17 of 35

Anonymous
Not applicable
FileSystemObject and Regular Expresions are resources that comes from MS VBScript, some of them availabe on VB6 and some of them not, like regular expressions, that need a reference to the vbscript type library

i use to code this way on DDCH scripts
http://www.thescriptvault.net/forum//index.php?board=2.0

but not usually on VBA projects
0 Likes
Message 18 of 35

Anonymous
Not applicable
K...

I just use what ever I can to do what I need to do.....
0 Likes
Message 19 of 35

Anonymous
Not applicable
There is the Ci_Color class.....

Hope it helps.

One thing I realized tought: you will not be able to recreate hatches... just their boundaries. So you can simply remove the lines in the Read function (and the member variable) and you won't have any problems. If you want to be able to recreate hatches, you will need to tweek a few things in the Read and Create methods..... Up to you on this one, I knida don't have any time for this.... Sorry.
0 Likes
Message 20 of 35

Anonymous
Not applicable
only want to recreate boundaries

ill test it this weekend and keep you informed

thanks a lot again
0 Likes