Jump to content

How to put hatch in multiple polygons..


merlin_m007

Recommended Posts

hai all

 

i am a bigner in cad

my boss had given me a dwg which contains 1000 s of polygons (closed polylines)and want me to hatch all indipendently

 

pls help

 

any lisp available?

if so pls mail to

rajtoms@saudia.com

 

or post here

 

any help will be mutch appreciated

Link to comment
Share on other sites

This LISP might help you, it's what I use all the time.

 

Pick an existing hatch then pick internal points.

 

Change the keyboard shortcut "gh" to whatever suits you

 

;;; The following function will match a hatch based on its properties,
;;; making the new hatch boundary-associative.
;;; (equivalent to the "inherit properties" option
(defun matchhatch (/ intpoint entlayer entcolor pattern entltype hscale hangle)
 (setq prev_echo (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "_.undo" "_be")
 (setq ent (entsel))
 (setq entlist (entget (car ent)))
 (if (= (cdr (assoc 0 entlist)) "HATCH")
   (progn
     (setq intpoint (cadr ent))
     (setq entlayer (cdr (assoc 8 entlist)))
     (setq entcolor (cdr (assoc 62 entlist)))
     (if (= entcolor nil); (bylayer returns nil) 
(setq entcolor "bylayer")
     )
     (setq entltype (cdr (assoc 6 entlist)))
     (if (= entltype nil)
(setq entltype "bylayer")
     )
     (setq pattern (cdr (assoc 2 entlist)))
     (setq hscale (cdr (assoc 41 entlist)))
     (setq hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))
     (setq intpoint T)
     (setq prev_osmode (getvar "osmode"))
     (setvar "osmode" 0)
     (while (/= intpoint nil)
(setq intpoint (getpoint "\nSpecify internal point: "))
(command "_.bhatch" "a" "a" "y" "" "_p" pattern hscale hangle intpoint "")
(command "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
     )
     (setvar "osmode" prev_osmode)
     (graphscr)
   )
   (princ "\nNo hatch selected.")
 )
 (command "_.undo" "_end")
 (setvar "cmdecho" prev_echo)
 (princ)
)
;; main function
(defun c:gh () (matchhatch))

 

I don't have one that will do all polygons at once, but I can probably write one over the weekend -- how soon do you need it?

Link to comment
Share on other sites

This LISP might help you, ...

 

I don't have one that will do all polygons at once, but I can probably write one over the weekend -- how soon do you need it?

 

That would be helpful to me.

Anytime is fine. Always looking for helpful code.

Link to comment
Share on other sites

hai all

 

i am a bigner in cad

my boss had given me a dwg which contains 1000 s of polygons (closed polylines)and want me to hatch all indipendently

 

pls help

 

any lisp available?

 

That would be helpful to me.

 

Here you go:

 

(defun c:mhatch (/ ss1 entlayer entcolor pattern entltype hscale hangle)
 (setq prev_echo (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (command "_.undo" "_be")
 (gethatch)
 (setq ss1 (ssget))
 (setq ent-index 0)
 (setq update-index 0)
 (repeat (sslength ss1)
   (setq entname (ssname ss1 ent-index))
   (command "_.bhatch" "a" "a" "y" "" "_p" pattern hscale hangle "s" entname "" "")
   (command "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
   (setq update-index (1+ update-index))
   (setq ent-index (1+ ent-index))
 ); repeat  
 (princ (strcat "\nIndividually hatched " (itoa update-index) " entity(ies).")); closing msg
 (graphscr)
 (command "_.undo" "_end")
 (setvar "cmdecho" prev_echo)
 (princ)
)

;;; Function to obtain hatch information
(defun gethatch ( )
 (setq ent (entsel))
 (setq entlist (entget (car ent)))
 (if (= (cdr (assoc 0 entlist)) "HATCH")
   (progn
     (setq intpoint (cadr ent))
     (setq entlayer (cdr (assoc 8 entlist)))
     (setq entcolor (cdr (assoc 62 entlist)))
     (if (= entcolor nil); (bylayer returns nil) 
(setq entcolor "bylayer")
     )
     (setq entltype (cdr (assoc 6 entlist)))
     (if (= entltype nil)
(setq entltype "bylayer")
     )
     (setq pattern (cdr (assoc 2 entlist)))
     (setq hscale (cdr (assoc 41 entlist)))
     (setq hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))    
   )
   (princ "\nNo hatch selected.")
 )
 (princ)
)

 

Cheap and dirty, but it works well.

Link to comment
Share on other sites

  • 8 years later...

This lisp is not working in Autocad 2017 the following errors gets displayed:

 

error: bad argument type: numberp: nil

 

Need some of your help over here, thanks in advance!

Link to comment
Share on other sites

LISP in Post #4 works fine in AutoCAD 2018.

 

Have you tried a different drawing or a different hatch? Post a drawing that does this maybe someone can figure it out. Also, did you do anything to the code? Try posting the Code you are using. Please read the Code Posting Guidelines and include the Code in Code Tags.[NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

Link to comment
Share on other sites

did a few minor mod's, maybe this will work better for U

 

 

; [url]http://www.cadtutor.net/forum/showthread.php?32917-How-to-put-hatch-in-multiple-polygons[/url]..
(defun c:mhatch (/ prev_echo ent intpoint entlist entlayer entcolor pattern entltype hscale hangle intpoint ss1)
 (setq prev_echo (getvar "cmdecho"))  (setvar "cmdecho" 0)  (command "_.undo" "_be")
 (gethatch)
 (if ent
   (progn
     (princ "\nSelect objects : ")
     (if (setq ss1 (ssget))
(progn
  (setq ent-index 0 update-index 0)
  (repeat (sslength ss1)
    (setq entname (ssname ss1 ent-index))
    (command-s "_.hatch" "a" "a" "y" "" "_p" pattern hscale hangle "s" entname "" "")
    (command-s "_.chprop" "l" "" "la" entlayer "c" entcolor "lt" entltype "")
    (setq update-index (1+ update-index) ent-index (1+ ent-index)))
)
(princ "\nNo objects were selected")
     )
   )
   (princ "\nNo (valid) hatch object was selected - nothing was hatched")
 )
 (if (and update-index (> update-index 0))
   (princ (strcat "\nIndividually hatched " (itoa update-index) " entity(ies).")))
 (graphscr)(command "_.undo" "_end")(setvar "cmdecho" prev_echo)
 (princ)
)
;;; Function to obtain hatch information
(defun gethatch ()
 (princ "\nSelect hatch : ")
 (if (and (setq ent (entsel)) (setq entlist (entget (car ent))) (= (cdr (assoc 0 entlist)) "HATCH"))
   (progn
     (setq intpoint (cadr ent) entlayer (cdr (assoc 8 entlist)) pattern (cdr (assoc 2 entlist))
    hscale (cdr (assoc 41 entlist)) hangle (* (/ (cdr (assoc 52 entlist)) pi) 180.0))
     (if (= (setq entcolor (cdr (assoc 62 entlist))) nil) (setq entcolor "bylayer"))
     (if (= (setq entltype (cdr (assoc 6 entlist))) nil) (setq entltype "bylayer"))
   )
   (progn (princ "\nNo hatch selected.") (setq ent nil))
 )
)

 

 

FWIW , bhatch command has button inherit properties and toggle 'Create separate hatches' and command seems to fail with user hatches.

 

 

gr.Rlx

Edited by rlx
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...