Code Red > AutoLISP (Vanilla / Visual)
Smart Selection Set Routine?
KewlToyZ:
Has anyone seen or messed with a smart selection routine where the user can have multiple items autoselect when meeting some criteria or multiple criteria?
Like a small dialog with checkboxes for TEXT, LAYER, BLOCK, ENTITY TYPE, OBJECT TYPE.
Then all objects in the drawing meeting that criteria become selected?
We have the "Select Similiar" command available in MEP/ABS 2008, but I wondered if someone else had considered an intelligent selection routine to help themselves out already. It seemed like a time saver others would be interested in.
T.Willey:
I have used the filter command in the past to select like objects. I have also written two routines, one to select by layer, and the other to select by object type.
gile:
Hi,
I wrote this one.
Two commands are defined SSM and SSMM.
Tthe first one allows a single entity selection to create the selection set of all objects matching the entity properties toogled in dialog.
The second allows to loop selecting entities and toogle properties to be matched.
--- Code: ---;; SSM & SSMM -Gilles Chanteau- 19/04/2007
;; Select all objects wich have the same properties as those of selected object which are
;; toggled in dialog box.
;;
;; Revised on 08/10/2007
;; Added "Block name tile.
;; Added SSMM function to allow multiple entity filter
;;;=====================================================================================;;;
;; Dialog
(defun ssmatch_box (ent / elst nam col lst dis dcl_id w h)
(setq elst (entget ent)
nam (if (= (cdr (assoc 0 elst)) "INSERT")
(assoc 2 elst)
)
col (cond ((assoc 420 elst))
((assoc 62 elst))
('(62 . 256))
)
lst (list (assoc 0 elst)
col
(assoc 8 elst)
(cond
((assoc 6 elst))
('(6 . "BYLAYER"))
)
(cond
((assoc 370 elst))
('(370 . -1))
)
)
col (cdr col)
dis (cond
((cdr (assoc 62 elst)))
((cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 elst))))))
)
dcl_id (load_dialog "ssmatch_box.dcl")
)
(and nam (setq lst (cons nam lst)))
(if (not (new_dialog "ssmatch_box" dcl_id))
(exit)
)
(setq w (dimx_tile "e_col")
h (dimy_tile "e_col")
)
(start_image "e_col")
(fill_image 0 0 w h dis)
(end_image)
(set_tile "e_ent" (cdr (assoc 0 elst)))
(if nam
(progn
(set_tile "e_nam" (cdr (assoc 2 elst)))
(mode_tile "nam" 0)
)
(mode_tile "nam" 1)
)
(set_tile "t_col"
(cond
((= col 256) "DuCalque")
((= col 0) "DuBloc")
((< 256 col)
(strcat (itoa (lsh col -16))
","
(itoa (lsh (lsh col 16) -24))
","
(itoa (lsh (lsh col 24) -24))
)
)
((itoa col))
)
)
(set_tile "e_lay" (cdr (assoc 8 elst)))
(set_tile "e_typ"
(cond
((or (null (cdr (assoc 6 elst)))
(= (strcase (cdr (assoc 6 elst))) "BYLAYER")
)
"DuCalque"
)
((= (strcase (cdr (assoc 6 lst))) "BYBLOCK")
"DuBloc"
)
((cdr (assoc 6 lst)))
)
)
(set_tile "e_wid"
(cond
((null (cdr (assoc 370 elst))) "ByLayer")
((= -1 (cdr (assoc 370 elst))) "ByLayer")
((= -2 (cdr (assoc 370 elst))) "ByBlock")
((= -3 (cdr (assoc 370 elst))) "Default")
((rtos (/ (cdr (assoc 370 elst)) 100.0) 2 2))
)
)
(action_tile
"accept"
"(or (= \"1\" (get_tile \"ent\"))
(setq lst (vl-remove (assoc 0 lst) lst))
)
(or (= \"1\" (get_tile \"nam\"))
(setq lst (vl-remove (assoc 2 lst) lst))
)
(or (= \"1\" (get_tile \"col\"))
(setq lst (vl-remove (assoc 420 lst)
(vl-remove (assoc 62 lst) lst)))
)
(or (= \"1\" (get_tile \"lay\"))
(setq lst (vl-remove (assoc 8 lst) lst))
)
(or (= \"1\" (get_tile \"typ\"))
(setq lst (vl-remove (assoc 6 lst) lst))
)
(or (= \"1\" (get_tile \"wid\"))
(setq lst (vl-remove (assoc 370 lst) lst))
)
(done_dialog)"
)
(action_tile "cancel" "(setq lst nil)")
(start_dialog)
(unload_dialog dcl_id)
lst
)
;;;=====================================================================================;;;
;; Calling functions
;; Single entity filter
(defun c:ssm (/ ss ent lst)
(and
(or
(and
(setq ss (cadr (ssgetfirst)))
(= 1 (sslength ss))
(setq ent (ssname ss 0))
)
(and
(sssetfirst nil nil)
(setq ent (car (entsel)))
)
)
(setq lst (ssmatch_box ent))
(sssetfirst nil (ssget "_X" lst))
)
(princ)
)
;; Multiple entity filter
(defun c:ssmm (/ ss ent lst n tmp elt)
(setq ss (ssadd))
(while (setq ent (car (entsel "\nSelect source object: ")))
(setq lst (ssmatch_box ent)
n 0
)
(princ
"\nSelect objects (or Enter for \"All\"): "
)
(if (not (setq tmp (ssget lst)))
(setq tmp (ssget "_X" lst))
)
(while (setq elt (ssname tmp n))
(ssadd elt ss)
(redraw elt 3)
(setq n (1+ n))
)
(setq tmp nil)
)
(sssetfirst nil ss)
(princ)
)
--- End code ---
Ssmatch.dcl file
--- Code: ---ssmatch_box:dialog{
label="Properties";
:boxed_row{
:column{
:toggle{
label="Entity type";
key="ent";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
:toggle{
label="Block name";
key="nam";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
:toggle{
label="Color";
key="col";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
:toggle{
label="Layer";
key="lay";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
:toggle{
label="Line type";
key="typ";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
:toggle{
label="Line width";
key="wid";
value="0";
fixed_width=true;
allow_accept=true;
}
spacer;
}
:column{
:text{
key="e_ent";
width=15;
}
spacer;
:text{
key="e_nam";
width=15;
}
spacer;
:row{
:image{
key="e_col";
height=1;
width=1;
}
:text{
key="t_col";
width=10;
}
}
spacer;
spacer;
:text{
key="e_lay";
width=15;
}
spacer;
:text{
key="e_typ";
width=15;
}
spacer;
:text{
key="e_wid";
width=15;
}
spacer;
}
}
spacer;
ok_cancel;
}
--- End code ---
KewlToyZ:
Thanks Gile!
Nice system as it stands!
CAB:
Gile,
I like you routine a lot, Thanks.
There was a problem that cancel did not cancel so I tweaked it a bit.
Hope you don't mind.
--- Code: ---;; Multiple entity filter
;; Loops the selection process to gather ss of more than
;; one set of properties
(defun c:ssmm (/ ss ent lst tmp prm)
(setq ss (ssadd)
prm "\nSelect source for properties: " )
(while (and
(setq ent (car (entsel prm)))
(setq lst (ssmatch_box ent))
)
(setq prm "\nSelect another source for properties (or [Enter] if done). "
tmp nil)
(princ "\nSelect objects to match (or Enter for \"All\"): ")
(if (not (setq tmp (ssget lst)))
(setq tmp (ssget "_X" lst))
)
(mapcar '(lambda(x) (ssadd x ss)(redraw x 3))
(vl-remove-if 'listp (mapcar 'cadr (ssnamex tmp))))
)
(sssetfirst nil ss)
(prompt "\nSelections will be highlited.")
(princ)
)
--- End code ---
Navigation
[0] Message Index
[#] Next page
Go to full version