jpcadconsulting347236
2015-08-25, 05:48 PM
Hi folks,
I'm looking for a routine similar to superhatch that will:
Let me select a block (by name or by selecting it on screen)
Enter spacing for rows/columns
Select a boundary (polyline, circle, spline, etc.) either by internal point or "select object"
Fill that area with instances of that block at the desired spacing.
Superhatch was my first thought, and it's close... but when you explode the hatch, you get lines and arcs and I need the individual blocks to remain intact so I can extract data from them.
There are a few others out there (Supercopy, etc.) but none work quite properly for what I need.
Advanced Array comes close but its has it's own issues (mostly because it was written in 2007):
http://cadtips.cadalyst.com/content/filling
There are times when the setting of values regarding display of hatches (or your row spacing) can cause this routine to fail because it can (I assume) come up against the "Hatch too dense to display" error.
You cannot "select object(s)" to select the boundary, only "select internal point" which in large drawings can have issues.
It's "finicky" about how you enter the row and column distances (sometimes it just doesn't "take")
There is no undo "mark" (if that's what you call it) so if you need to undo, it steps through each block, one at a time, then the hatch elements... etc.
Anyone know of anything? I'm coming up empty.
Thanks in advance for your help. Following is the LSP and DCL for Advanced Array which should do exactly what I need but does not work well in 2014.
LSP
;;;Cadalyst AutoLISP Solutions July 2007 ALSPSOL0707.ZIP / ADARRAY.LSP (c) Tony Hotchkiss
;;;
(defun err (s)
(if (= s "Function cancelled")
(princ "\nADARRAY - cancelled: ")
(progn (princ "\nADARRAY - Error: ")
(princ s)
(terpri)
) ;_ progn
) ;_ end of if
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
) ;_ end of err
(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
) ;_ end of setv
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "CMDECHO" 0)
(setv "BLIPMODE" 0)
(setv "OSMODE" 0)
(setv "CLAYER" (getvar "CLAYER"))
) ;_ end of setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
) ;_ end of rsetv
(defun resetting ()
(rsetv "CMDECHO")
(rsetv "BLIPMODE")
(rsetv "OSMODE")
(rsetv "CLAYER")
(setq *error* oerr)
) ;_ end of resetting
(defun adarray ()
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq bnameindex nil)
(setq doit 4)
(setq ad_id (load_dialog "adarray.dcl"))
(while (>= doit 2)
(if (not (new_dialog "adarray" ad_id))
(exit)
) ;_ end of if
(init-array)
(action_tile "bname" "(setq bnameindex (atoi $value))")
(action_tile "row" "(setq *rowdist* (atof $value))")
(action_tile "col" "(setq *coldist* (atof $value))")
(action_tile "pick" "(done_dialog 3)")
(action_tile
"accept"
"(get-adarray-data) (done_dialog 1)"
) ;_ end of action_tile
(setq doit (start_dialog))
(cond
((= doit 1)
(do-array)
)
((= doit 3)
(setq *point0* (getpoint "\nPick a point: "))
)
) ;_ end of cond
) ;_ end of while
(unload_dialog ad_id)
) ;_ end-of adarray
(defun init-array ()
(setq blks (vla-get-blocks *thisdrawing*)
num (vla-get-Count blks)
*blknames* nil
i 1
) ;_ end of setq
(repeat (- num 2)
(setq blk (vla-item blks (setq i (1+ i)))
bname (vla-get-Name blk)
*blknames* (append *blknames* (list bname))
) ;_ end of setq
) ;_ end of repeat
(if *blknames*
(progn
(start_list "bname")
(mapcar 'add_list *blknames*)
(end_list)
) ;_ end of progn
) ;_ end of if
(if bnameindex
(set_tile "bname" (itoa bnameindex))
) ;_ end of if
(if *rowdist*
(set_tile "row" (rtos *rowdist*))
(set_tile "row" "2")
) ;_ end of if
(if *coldist*
(set_tile "col" (rtos *coldist*))
(set_tile "col" "2")
) ;_ end of if
) ;_ end of init-array
(defun get-adarray-data ()
(setq bnameindex (atoi (get_tile "bname")))
(setq *bname* (nth bnameindex *blknames*))
(setq *rowdist* (atoi (get_tile "row")))
(setq *coldist* (atoi (get_tile "col")))
) ;_ end-of get-tool-data
(defun do-array ()
(setq lyr "arr-hatch")
(vl-cmdf "Layer" "M" lyr "C" "green" "" "")
(vl-cmdf "-Hatch" *point0* "P" "U" "0.0" *rowdist* "N" "")
(vl-cmdf "Explode" (entlast))
(setq ss (ssget "X"
(list '(0 . "LINE")
(cons 8 lyr)
) ;_ end of list
) ;_ end of ssget
num (sslength ss)
i -1
) ;_ end of setq
(rsetv "CLAYER")
(repeat num
(setq en (ssname ss (setq i (1+ i))))
(vl-cmdf "Measure" en "B" *bname* "Y" *coldist*)
(entdel en)
) ;_ end of repeat
) ;_ end of do-array
(defun c:ad ()
(setting)
(adarray)
(resetting)
(princ)
) ;_ end of c:ad
(prompt "\nCopyright (c) 2007, Tony Hotchkiss")
(prompt "\nEnter AD to start")
DCL
// ADARRAY Dialogue Box - by Tony Hotchkiss 4/21/07
adarray : dialog // advanced array data
{
label = "ADAVANCED ARRAY";
:column {
:popup_list {
label = "Block name ";
key = "bname";
width = 8;
}// popup list
:edit_box {
label = "Distance between rows: ";
key = "row";
width = 8;
}// edit box
:edit_box {
label = "Distance between columns:";
key = "col";
width = 8;
}// edit box
:spacer {}
:spacer {}
: retirement_button {
key = "pick";
label = "Pick point";
}// retirement_button
}// column
ok_cancel;
: text {
label = "Copyright (c) 2007 Dr. A. Hotchkiss";
alignment = left;
}
} // adarray
-JP
I'm looking for a routine similar to superhatch that will:
Let me select a block (by name or by selecting it on screen)
Enter spacing for rows/columns
Select a boundary (polyline, circle, spline, etc.) either by internal point or "select object"
Fill that area with instances of that block at the desired spacing.
Superhatch was my first thought, and it's close... but when you explode the hatch, you get lines and arcs and I need the individual blocks to remain intact so I can extract data from them.
There are a few others out there (Supercopy, etc.) but none work quite properly for what I need.
Advanced Array comes close but its has it's own issues (mostly because it was written in 2007):
http://cadtips.cadalyst.com/content/filling
There are times when the setting of values regarding display of hatches (or your row spacing) can cause this routine to fail because it can (I assume) come up against the "Hatch too dense to display" error.
You cannot "select object(s)" to select the boundary, only "select internal point" which in large drawings can have issues.
It's "finicky" about how you enter the row and column distances (sometimes it just doesn't "take")
There is no undo "mark" (if that's what you call it) so if you need to undo, it steps through each block, one at a time, then the hatch elements... etc.
Anyone know of anything? I'm coming up empty.
Thanks in advance for your help. Following is the LSP and DCL for Advanced Array which should do exactly what I need but does not work well in 2014.
LSP
;;;Cadalyst AutoLISP Solutions July 2007 ALSPSOL0707.ZIP / ADARRAY.LSP (c) Tony Hotchkiss
;;;
(defun err (s)
(if (= s "Function cancelled")
(princ "\nADARRAY - cancelled: ")
(progn (princ "\nADARRAY - Error: ")
(princ s)
(terpri)
) ;_ progn
) ;_ end of if
(resetting)
(princ "SYSTEM VARIABLES have been reset\n")
(princ)
) ;_ end of err
(defun setv (systvar newval)
(setq x (read (strcat systvar "1")))
(set x (getvar systvar))
(setvar systvar newval)
) ;_ end of setv
(defun setting ()
(setq oerr *error*)
(setq *error* err)
(setv "CMDECHO" 0)
(setv "BLIPMODE" 0)
(setv "OSMODE" 0)
(setv "CLAYER" (getvar "CLAYER"))
) ;_ end of setting
(defun rsetv (systvar)
(setq x (read (strcat systvar "1")))
(setvar systvar (eval x))
) ;_ end of rsetv
(defun resetting ()
(rsetv "CMDECHO")
(rsetv "BLIPMODE")
(rsetv "OSMODE")
(rsetv "CLAYER")
(setq *error* oerr)
) ;_ end of resetting
(defun adarray ()
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq bnameindex nil)
(setq doit 4)
(setq ad_id (load_dialog "adarray.dcl"))
(while (>= doit 2)
(if (not (new_dialog "adarray" ad_id))
(exit)
) ;_ end of if
(init-array)
(action_tile "bname" "(setq bnameindex (atoi $value))")
(action_tile "row" "(setq *rowdist* (atof $value))")
(action_tile "col" "(setq *coldist* (atof $value))")
(action_tile "pick" "(done_dialog 3)")
(action_tile
"accept"
"(get-adarray-data) (done_dialog 1)"
) ;_ end of action_tile
(setq doit (start_dialog))
(cond
((= doit 1)
(do-array)
)
((= doit 3)
(setq *point0* (getpoint "\nPick a point: "))
)
) ;_ end of cond
) ;_ end of while
(unload_dialog ad_id)
) ;_ end-of adarray
(defun init-array ()
(setq blks (vla-get-blocks *thisdrawing*)
num (vla-get-Count blks)
*blknames* nil
i 1
) ;_ end of setq
(repeat (- num 2)
(setq blk (vla-item blks (setq i (1+ i)))
bname (vla-get-Name blk)
*blknames* (append *blknames* (list bname))
) ;_ end of setq
) ;_ end of repeat
(if *blknames*
(progn
(start_list "bname")
(mapcar 'add_list *blknames*)
(end_list)
) ;_ end of progn
) ;_ end of if
(if bnameindex
(set_tile "bname" (itoa bnameindex))
) ;_ end of if
(if *rowdist*
(set_tile "row" (rtos *rowdist*))
(set_tile "row" "2")
) ;_ end of if
(if *coldist*
(set_tile "col" (rtos *coldist*))
(set_tile "col" "2")
) ;_ end of if
) ;_ end of init-array
(defun get-adarray-data ()
(setq bnameindex (atoi (get_tile "bname")))
(setq *bname* (nth bnameindex *blknames*))
(setq *rowdist* (atoi (get_tile "row")))
(setq *coldist* (atoi (get_tile "col")))
) ;_ end-of get-tool-data
(defun do-array ()
(setq lyr "arr-hatch")
(vl-cmdf "Layer" "M" lyr "C" "green" "" "")
(vl-cmdf "-Hatch" *point0* "P" "U" "0.0" *rowdist* "N" "")
(vl-cmdf "Explode" (entlast))
(setq ss (ssget "X"
(list '(0 . "LINE")
(cons 8 lyr)
) ;_ end of list
) ;_ end of ssget
num (sslength ss)
i -1
) ;_ end of setq
(rsetv "CLAYER")
(repeat num
(setq en (ssname ss (setq i (1+ i))))
(vl-cmdf "Measure" en "B" *bname* "Y" *coldist*)
(entdel en)
) ;_ end of repeat
) ;_ end of do-array
(defun c:ad ()
(setting)
(adarray)
(resetting)
(princ)
) ;_ end of c:ad
(prompt "\nCopyright (c) 2007, Tony Hotchkiss")
(prompt "\nEnter AD to start")
DCL
// ADARRAY Dialogue Box - by Tony Hotchkiss 4/21/07
adarray : dialog // advanced array data
{
label = "ADAVANCED ARRAY";
:column {
:popup_list {
label = "Block name ";
key = "bname";
width = 8;
}// popup list
:edit_box {
label = "Distance between rows: ";
key = "row";
width = 8;
}// edit box
:edit_box {
label = "Distance between columns:";
key = "col";
width = 8;
}// edit box
:spacer {}
:spacer {}
: retirement_button {
key = "pick";
label = "Pick point";
}// retirement_button
}// column
ok_cancel;
: text {
label = "Copyright (c) 2007 Dr. A. Hotchkiss";
alignment = left;
}
} // adarray
-JP