AutoLISP: Merge Hatches Join Hatches

I didn’t know how useful this LISP routine was until I saw it posted over at the swamp.org. At my previous job, I would receive drawing that were contained too many hatches and some hatches were not hatched correctly. So I would end up deleting all of the hatches and then turn the lines that formed the hatch boundary into polylines. I would then hatched the newly formed polyline using a consistent hatch.

Well, with this routine, I would no longer have to delete any hatches or join any lines.

Here’s how:

  • MH <enter> to start Merge Hatch
  • Select an existing hatch pattern in the drawing to specify what hatch to use.
  • Select all of the hatches that you want to be merged into one hatch. (Note: Even though you already selected a hatch to specify what pattern to use, you need to select that hatch again so that it is included in the selection set)
  • <enter> to finish selecting

That’s it.

;; © Juan Villarreal 11.20.2011 ;;
;; massoc (Jaysen Long) ;;
;; Minor Modification by Jvillarreal ;;
;; Extracts info from list by key ;;
;; Found @ http://www.theswamp.org/index.php?topic=40149.0
(defun massoc (key alist / x nlist)
(foreach x alist
(if
(eq key (car x))
(setq nlist (cons x nlist))
)
)
(reverse nlist)
);defun
(defun c:MergeHatch ( / hentinfo ss i ent ent# seedpt# entinfo entinfo2 ent# seedpt# seedpts MergedHatchList)
(while (/= (cdr (assoc 0 hentinfo)) "HATCH")
(setq hentinfo (car (entsel "\nSelect Hatch Pattern to use:")))
(If hentinfo (setq hentinfo (entget hentinfo)) (princ "\nMissed. Try again.")))
(while (not ss) (princ "\nSelect hatch entities to merge:")(setq ss (ssget '((0 . "HATCH")))))
(setq MergedHatchList
(list (cons 0 "HATCH")
(cons 100 "AcDbEntity")
(assoc 8 hentinfo)
(cons 100 "AcDbHatch")
(assoc 10 hentinfo)
(assoc 210 hentinfo)
(assoc 2 hentinfo)
(assoc 70 hentinfo)
(assoc 71 hentinfo)
(cons 91 (sslength ss))
) i -1 seedpt# 0 ent# 0)
(repeat (sslength ss)
(setq n -1
entinfo (entget (ssname ss (setq i (1+ i))))
entinfo2 (member (assoc 92 entinfo) entinfo)
entinfo2 (reverse (cdr (member (assoc 75 entinfo2)(reverse entinfo2))))
ent# (+ ent# (cdr (assoc 91 entinfo)))
seedpt# (+ seedpt# (cdr (assoc 98 entinfo)))
seedpts (append seedpts (cdr (member (assoc 98 entinfo) entinfo)))
MergedHatchList (append MergedHatchList entinfo2)
)
(entdel (ssname ss i))
)
(setq MergedHatchList (subst (cons 91 ent#)(assoc 91 MergedHatchList) MergedHatchList)
MergedHatchList
(append MergedHatchList
(append
(reverse (cdr (member (assoc 98 hentinfo)(reverse (member (assoc 75 hentinfo) hentinfo)))))
(cons (cons 98 seedpt#) seedpts))))
(if (= (cdr (assoc 71 hentinfo)) 1)(setq MergedHatchList (append MergedHatchList '((-3 ("ACAD" (1010 0.0 0.0 0.0)))))))
(entmake MergedHatchList)
(setq ent (entlast))
(if (= (cdr (assoc 71 hentinfo)) 1)
(mapcar
'(lambda (x / entlist)
(setq entlist (entget (cdr x)))
(entmod (subst (cons 330 ent) (assoc 330 entlist) entlist))
)
(massoc 330 MergedHatchList)
)
)
)
(defun c:MH () (c:MergeHatch))
Advertisements

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, AutoLISP: Creating, AutoLISP: Modify, Hatch, Modifying, Uncategorized. Bookmark the permalink.

2 Responses to AutoLISP: Merge Hatches Join Hatches

  1. pascale says:

    I dont know about you guys, but this lisp doesnt always work for some reason (which i cant figure out).
    I have had documents where it worked, documents where it didnt work and documents where it used to work.
    Would any of you know anything about this problem?

    • AutoCAD Tips says:

      hello,
      I hope this is an easy solution. I went back to the forum where I found this routine and saw that the way that the routine is currently set up, it doesn’t work with solid hatches. So I am hoping that this might be the issue that you are having with it as well because the author added a solution for it. If this doesn’t solve your issues with the routine, I would suggest that you post a response in the forum (link to forum is at the top of code) as well because I know that they would love to get the routine working for everyone.

      Below is the snippet from the author that resolves solid hatches:

      Sorry for the late response. I haven’t been on my comp the last few days.
      The only reason it doesn’t work for solid hatching is I didn’t have a need for it.
      It doesn’t require much of a modification.

      Change seedpts under setq to something like this: seedpts (append seedpts (vl-remove-if ‘(lambda (pair)(/= (car pair) 10))(cdr (member (assoc 98 entinfo) entinfo))))

      The first associativity check isn’t necessary..so just replace: (if (= (cdr (assoc 71 hentinfo)) 1)(setq MergedHatchList (append MergedHatchList ‘((-3 (“ACAD” (1010 0.0 0.0 0.0)))))))

      with: (if (= (cdr (assoc 70 hentinfo)) 1)(setq MergedHatchList (append MergedHatchList (member (assoc 450 hentinfo) hentinfo))))

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s