Merge all hatch objects by pattern name

[jpcadconsulting347236]

Hi again gang,

I'm looking for a LISP routine that will merge all hatch objects of a particular pattern name(s).

There are a finite number of specific pattern names I'd like to do this to, so there would ideally be no user input, except to initiate the command. It would then search the drawing for all instances of "Pattern 1" and merge them all, then move on to "Pattern 2", etc...

"Why would you want this?" you may ask.

I am using data extraction to get the area of particular hatches that represent ground-cover planting. The problem is, the resulting table lists each individual hatch object separately, even if they are the same pattern. So it's not giving me total areas for "Pattern 1", "Pattern 2", etc.

Unless I'm missing some aspect of the data extraction process, I need to combine all the similar hatches first.

Thanks for any help you can give.

-JP

[CCarleton]

This isn't exactly what you're looking for, but it might be a close second place for the time being.

You select the hatch with the pattern you want, then you select all the hatches you want to merge and hit enter.



;; © 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))

[BlackBox]

If memory serves (and I could be mistaken, as I'm on my iPhone at the moment), you can GROUP the like hatches, and then invoke SUPERHATCH Express Tool Command.

[jpcadconsulting347236]

Thanks to both of you! I'll give both things a try and keep you posted.

[jpcadconsulting347236]

Thanks Varlth. It's close (and it works great) I'm just trying to eliminate as many steps as I can for my users. They have need to merge all hatches of similar pattern name quite often.

I'm trying to modify it so that when you pick the initial hatch, it pulls the pattern name, then creates a selection selection set of "all hatches of that pattern name" and merges them.

It's gonna be slow going as I'm figuring this out as I go. ;-)

Thanks for your help!

[jpcadconsulting347236]

So far I have this test code which successfully pulls the pattern name from a selected hatch:


(defun c:test (/ hatchobj hatchname)
(vl-load-com)
(setq hatchobj (vlax-ename->vla-object (car (entsel "\nSelect hatch to merge: "))))
(setq hatchname (vla-get-PatternName hatchobj))
(princ hatchname)
)

Next step, create a selection set of all hatches of name "hatchname".

I'll keep you posted.

[Opie]

What is the case when similar hatches are found but reside on different layers?

[jpcadconsulting347236]

They would likely all be on the same layer anyway, but I suppose they could all wind up on the layer of the originally selected hatch.

Still working on creating a selection set by hatch name...

Thanks as always.

[BlackBox]

Why not just iterate the Database filtering for "AcDbHatch" ObjectName (which makes this utility able to be batch processed via ObjectDBX, other open Documents, etc.), or a Selection Set of all Hatches, then store them in a list of lists, where each list element is comprised of a first element of "LayerName" and the second element is a list of Hatch Objects found on same... Once done, simply iterate the list of lists, combining all Hatch Objects found on a given Layer respectively.

This way, you retain the original Layer settings for referencing drawings, Layer States, etc. and effectively combine all of the Outer/Inner loops.

[jpcadconsulting347236]

Why not just iterate the Database filtering for "AcDbHatch" ObjectName (which makes this utility able to be batch processed via ObjectDBX, other open Documents, etc.), or a Selection Set of all Hatches, then store them in a list of lists, where each list element is comprised of a first element of "LayerName" and the second element is a list of Hatch Objects found on same... Once done, simply iterate the list of lists, combining all Hatch Objects found on a given Layer respectively.

This way, you retain the original Layer settings for referencing drawings, Layer States, etc. and effectively combine all of the Outer/Inner loops.

You flatter me with your assessment of my coding skills. ;-)

Seriously though this is all good. I'm still wrapping my brain around the myriad ways anything can be accomplished. A lot of it is over my head at the moment but that's good.

[BlackBox]

You flatter me with your assessment of my coding skills. ;-)

Seriously though this is all good. I'm still wrapping my brain around the myriad ways anything can be accomplished. A lot of it is over my head at the moment but that's good.


Sorry - no compliment intended. :lol: Haha

I do however, believe that you are in fact capable of meeting both the specified, and implied tasks of what I posit above, even if that means learning a thing or two along the way. :beer:

Give it a try, so you can see, that you're capable of more than you think.