solid hatch in more than 1 object..

Hi there ppl

I want to full more than 1 closed object (2D) with a solid hatch. Every hatch must be a single hatch, so when I will click on the hatch, they seems like expoded.
All the objects are on 1 single layer, and this layer is the only one set ON. The others are all of, so the selection can be "all", but like I said, the hatch must be single for every object, and not 1 hatch for all the objects..

Someone know or can build a lisp to do this?

Thanks, Chris

 

Hi Chris

This program adds hatch to all closed (lw)polylines on the desired layer:

Code:

(defun C:HatchAllPoly ( / AcaDoc CurEnt CurSet CurSpc FltLst HatObj OutArr)
(vl-load-com)
(setq FltLst '(
(0 . "LWPOLYLINE,POLYLINE")
(8 . "MyPolyLayer")	;<-Set your object layer name
(-4 . "&=") (70 . 1)	;Closed
(-4 . "<NOT")
(-4 . "<OR")		;Not:
(-4 . "&=") (70 .  8)	;-3DPoly
(-4 . "&=") (70 . 16)	;-3DMesh
(-4 . "&=") (70 . 64)	;-PolyFace
(-4 . "OR>")
(-4 . "NOT>")
)
AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurSpc (vla-get-ModelSpace AcaDoc)
)
(if (setq CurSet (ssget "X" FltLst))
(progn
(vla-StartUndoMark AcaDoc)
(while (setq CurEnt (ssname CurSet 0))
(setq HatObj (vla-AddHatch CurSpc
acHatchPatternTypePredefined
"SOLID" :vlax-true
)
OutArr (vlax-make-safearray vlax-vbObject '(0 . 0))
)
(vlax-safearray-fill OutArr (list (vlax-ename->vla-object CurEnt)))
(vla-AppendOuterLoop HatObj OutArr)
(vla-put-Layer HatObj "MyHatchLayer") ;<-Set your hatch layer name
(ssdel CurEnt CurSet)
)
(vla-EndUndoMark AcaDoc)
)
)
(princ)
)

Cheers

 

hi there Jürg, thanks for the reply.
Sorry I don't know very much about LISP, I've to put the lines you posted into a file .txt and save it with the .lsp extension? And then load it into Autocad?
Wich is the name of the function to start this LISP?

Thanks in advance, nice to hear that you're from Switzerland too, I live in Lugano, sorry but I don't speak German!

Chris

 

Hi Chris

HatchAllPoly

Glad to help a compatriot...¦-)

Cheers

 

Chris

About your nickname... Sepultura and Metallica?

Cheers

 

hey Jürg, I've still to take a look at your website

Yes it's a misc of Sepultura and Metallica, but finally a solo project of Jason Newsted of Metallica back in 1994.
Anyway I'm just a big Metallica fan, I don't like Sepultura

I just tested the lisp, I copied the text you posted into a TXT and renamed it hatchallpoly.lsp
I loaded it into Autocad, I tried to write HatchAllPoly or _HatchAllPoly but nothing happen...

What I've to do??
If you can, send me an e-mail at

Thanks!

Chris

 

Hi Chris

I like some tracks - not all - of both...

Did you changed the layer names for your purpose? -> see comments in the code

Cheers

 

ok finally it works..but just with polygons create with the AutoCAD commands "polygon" or "rectangle" and not a polygon created with the "polyline" command....right?

Thanks anyway

Chris

 

Hi Chris

As you mentioned in your first post, the routine works with all Polylines and
LWPolylines they are closed. I've done some modifications to proceed also non
closed polylines and added messages to display the result.

Code:

(defun C:HatchAllPoly ( / AcaDoc CurEnt CurSet CurSpc ErrCnt FltLst HatObj
ObjCnt OutArr)
(vl-load-com)
(setq FltLst '(
(0 . "LWPOLYLINE,POLYLINE")
(8 . "MyPolyLayer")	;<-Set your object layer name
(-4 . "<NOT")
(-4 . "<OR")		;Not:
(-4 . "&=") (70 .  8)	;-3DPoly
(-4 . "&=") (70 . 16)	;-3DMesh
(-4 . "&=") (70 . 64)	;-PolyFace
(-4 . "OR>")
(-4 . "NOT>")
)
AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurSpc (vla-get-ModelSpace AcaDoc)
ErrCnt 0
ObjCnt 0
)
(if (setq CurSet (ssget "X" FltLst))
(progn
(vla-StartUndoMark AcaDoc)
(while (setq CurEnt (ssname CurSet 0))
(setq HatObj (vla-AddHatch CurSpc
acHatchPatternTypePredefined
"SOLID" :vlax-true
)
OutArr (vlax-make-safearray vlax-vbObject '(0 . 0))
)
(vlax-safearray-fill OutArr (list (vlax-ename->vla-object CurEnt)))
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-invoke-method (list HatObj 'AppendOuterLoop OutArr)
)
)
(progn
(vla-Delete HatObj)
(setq ErrCnt (1+ ErrCnt))
)
(progn
(vla-Evaluate HatObj)
(vla-put-Layer HatObj "MyHatchLayer") ;<-Set your hatch layer name
(setq ObjCnt (1+ ObjCnt))
)
)
(ssdel CurEnt CurSet)
)
(princ
(strcat "\n" (itoa ObjCnt) " object(s) suceed, "
(itoa ErrCnt) " failed."
)
)
(vla-EndUndoMark AcaDoc)
)
(princ "\nCan't find any object(s) to proceed.")
)
(princ)
)

Cheers

 

Hey Jürg...this LSP is awesome!! it works fine, thanks a lot!

I'm at work and a friend asked me if it's possible to modify the LISP for full not just polygons made with polyline but made with normale lines. So every polygon that AutoCad can see "closed".
Is that possible?

Another question, that's by me:
Every time I've to change the layers name to let the LISP understand wich are the polygons that it has to "full" with an hatch. (I mean set "MyHatchLayer" etc).
There is a way to don't change this name, I mean..that Autocad have to hatch all the polygons that can see on the screen, so like when you do "selection"-->"all".
That's would be faster...and much more easy to do

let me know, and thanks for all this great work man!

Chris

 

Hi Chris

You're welcome...¦-)

In principle yes. There are two ways to realize:
- Join all lines to polylines (easy, see new version)
- Analyze all lines for congruent start-/endpoints (complicate)

No problem, see new version. Read the comments in the program carefully.

Code:

(defun C:HatchAllPoly ( / AcaDoc CurEnt CurObj CurSet CurSpc ErrCnt FltLst
HatObj ObjCnt OutArr)
(vl-load-com)
(setq FltLst '((0 . "LINE"))
AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-StartUndoMark AcaDoc)
(if (setq CurSet (ssget "X" FltLst))
(vl-cmdf "_.PEDIT" "_MUL" CurSet "" "_YES" "_JOI" 1E-8 "")
)
(setq FltLst '(
(0 . "LWPOLYLINE,POLYLINE")
(-4 . "<NOT")
(-4 . "<OR")		;Not:
(-4 . "&=") (70 .  8)	;-3DPoly
(-4 . "&=") (70 . 16)	;-3DMesh
(-4 . "&=") (70 . 64)	;-PolyFace
(-4 . "OR>")
(-4 . "NOT>")
)
CurSpc (vla-get-ModelSpace AcaDoc)
ErrCnt 0
ObjCnt 0
)
(if (setq CurSet (ssget "X" FltLst))
(progn
(while (setq CurEnt (ssname CurSet 0))
(setq CurObj (vlax-ename->vla-object CurEnt)
HatObj (vla-AddHatch CurSpc
acHatchPatternTypePredefined
"SOLID" :vlax-true
)
OutArr (vlax-make-safearray vlax-vbObject '(0 . 0))
)
(vlax-safearray-fill OutArr (list CurObj))
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vlax-invoke-method (list HatObj 'AppendOuterLoop OutArr)
)
)
(progn
(vla-Delete HatObj)
(setq ErrCnt (1+ ErrCnt))
)
(progn
(vla-Evaluate HatObj)
;- Option set hatch to object layer (remove the following line
;  if you wish to use the active layer or the option below):
(vla-put-Layer HatObj (vla-get-Layer CurObj))
;- Option set hatch to 'MyHatchLayer' (remove the following line
;  if you wish to use the active layer or the option above):
(vla-put-Layer HatObj "MyHatchLayer") ;<-Set your hatch layer name
(setq ObjCnt (1+ ObjCnt))
)
)
(ssdel CurEnt CurSet)
)
(princ
(strcat "\n" (itoa ObjCnt) " object(s) suceed, "
(itoa ErrCnt) " failed."
)
)
)
(princ "\nCan't find any object(s) to proceed.")
)
(vla-EndUndoMark AcaDoc)
(princ)
)

Cheers

 

that's awesome! it works fine...thank u very much man.

I will ask you maybe something other in the future..if you've time and I will find any new idea or problem about AutoCad eheh

I did a tour on your website...very interesting stuff and some nice LISP!

Have a nice day!
Chris