merlin_m007 Posted February 20, 2009 Share Posted February 20, 2009 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 Quote Link to comment Share on other sites More sharing options...
uddfl Posted February 20, 2009 Share Posted February 20, 2009 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? Quote Link to comment Share on other sites More sharing options...
dtkell Posted February 20, 2009 Share Posted February 20, 2009 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. Quote Link to comment Share on other sites More sharing options...
uddfl Posted February 20, 2009 Share Posted February 20, 2009 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. Quote Link to comment Share on other sites More sharing options...
dtkell Posted February 20, 2009 Share Posted February 20, 2009 That it does. Much thanks. Quote Link to comment Share on other sites More sharing options...
merlin_m007 Posted February 21, 2009 Author Share Posted February 21, 2009 thank u very much all my problem has been solved cad tutor ...RRRRROCKS ..... Quote Link to comment Share on other sites More sharing options...
akimaestro Posted January 19, 2018 Share Posted January 19, 2018 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! Quote Link to comment Share on other sites More sharing options...
SLW210 Posted January 19, 2018 Share Posted January 19, 2018 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted January 19, 2018 Share Posted January 19, 2018 (edited) 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 January 19, 2018 by rlx Quote Link to comment Share on other sites More sharing options...
ronjonp Posted January 19, 2018 Share Posted January 19, 2018 You should be able to do this without any code. Set HPSEPARATE to 1. Then use the hatch command. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 20, 2018 Share Posted January 20, 2018 ronjonp another of those never discovered commands well done, we take a sledge hammer to a task instead of a little ballpeen hammer. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.