;;; Edit_bloc - Gilles Chanteau - version 3.5 - 04/05/07
;;;
;;; Redefines the blocks after modifying the properties of their components.
;;;
;;; The changes affect:
;;; - be all blocks of the collection (or not inserted)
;;; - or all blocks in serted
;;; - a selection is made ??of blocks in the drawing.
;;;
;;; It is possible to :
;;; - change on a global scale
;;; - change the insertion unit (ACAD 2005 or newer)
;;; - put the objects of the blocks on a chosen layer
;;; - change the color, line type, line width and style
;;; plot (STB only) components in ByBlock or ByLayer.
;;;
;;; The blocks forming the nested blocks are treated
;;; Blocks inserted in the drawing are updated according
;;; to these changes.
;;;
;;; The parameters and properties of dynamic blocks are not taken
;;; into account by scale changes, a dialog box asks
;;; confirmation or change of scale for the block.
(vl-load-com)
(defun c:eb (/
;; Functions
e_b_err edit_prop scl_upd att_upd sub_upd
edit_bl
;; Variables
AcDoc dcl_id loop u_lst l_lst lt_lst
lw_lst lay lay-p col col-p tl
tl-p tl_n el el-p el_n plt
plt-p plt_n e_scl fact unt i_unt
ss w h dis ind rgb
cnm tbl all sel
)
;;;******************************************************************* ;;;
;; Redefinition *error*
(defun e_b_err (msg)
(if (or
(= msg "Function canceled")
(= msg "quit / abort")
)
(princ)
(princ (strcat "\nError: " msg))
)
(vla-endundomark
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq *error* m:err
m:err nil
)
(princ)
)
;;;******************************************************************* ;;;
(defun alert_bloc (name / dcl_id)
(setq dcl_id (load_dialog "Edit_bloc.dcl"))
(if (not (new_dialog "alert_bloc" dcl_id))
(exit)
)
(set_tile "txt" name)
(action_tile
"mod"
(strcat
"(if (= \"1\" $value)"
"(setq e_scl T)"
"(setq e_scl nil))"
)
)
(action_tile
"anl"
(strcat
"(if (= \"1\" $value)"
"(setq e_scl nil)"
"(setq e_scl T))"
)
)
(action_tile "accept" "(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
)
;;;******************************************************************* ;;;
;; Changing the properties of the components of the block
(defun edit_prop (ent / acc)
(if lay-p
(vla-put-Layer ent (nth lay l_lst))
)
(if col-p
(if (vla-object (ssname ss (setq n (1- n))))
)
(if (vlax-property-available-p obj 'EffectiveName)
(setq name (vla-get-EffectiveName obj))
(setq name (vla-get-Name obj))
)
(if
(and
(not (member name lst))
(= :vlax-false
(vla-get-isXref
(vla-item (vla-get-Blocks AcDoc) name)
)
)
)
(setq lst (cons name lst))
)
)
;; Adding Dynamic Blocks Anonymous
(and
(setq ss (ssget "_X" '((0 . "INSERT") (2 . "`*U*"))))
(repeat (setq n (sslength ss))
(setq
obj
(vlax-ename->vla-object (ssname ss (setq n (1- n))))
)
(if (and (member (vla-get-EffectiveName obj) lst)
(not (member (vla-get-Name obj) lst))
)
(setq lst (cons (vla-get-Name obj) lst))
)
)
)
;; Adding up the nested blocks to the list
(setq n_lst 0)
(while (setq name (nth n_lst lst))
(setq bloc (vla-item (vla-get-blocks acDoc) name))
(vlax-for ent bloc
(if (and (= (vla-get-ObjectName ent) "AcDbBlockReference")
(not (member (vla-get-name ent) lst))
)
(setq
lst (reverse (cons (vla-get-Name ent) (reverse lst)))
)
)
)
(setq n_lst (1+ n_lst))
)
)
;; If Full collection
(vlax-for bl (vla-get-blocks AcDoc)
(if (and (= :vlax-false (vla-get-isLayout bl))
(= :vlax-false (vla-get-isXref bl))
)
(setq lst (cons (vla-get-name bl) lst))
)
)
)
;; Changing blocks
(mapcar
'(lambda (name)
(setq bloc (vla-item (vla-get-blocks AcDoc) name))
(if (and e_scl
(< 16.1 (read (substr (getvar "ACADVER") 1 4)))
(= (vla-get-IsDynamicBlock bloc) :vlax-true)
(/= fact 1.0)
)
(progn
(setq e_scl nil)
(alert_bloc name)
)
)
(vlax-for ent bloc
(if (/= (vla-get-ObjectName ent) "AcDbZombieEntity")
(if (/= (vla-get-ObjectName ent) "AcDbBlockReference")
(progn
(if (and e_scl (/= fact 1.0)) ;_ Echelle
(vla-ScaleEntity ent (vla-get-origin bloc) fact)
)
(edit_prop ent)
)
(sub_upd ent bloc)
)
)
)
(if (vla-object
(ssname ss (setq n (1- n)))
)
)
(att_upd obj)
(scl_upd obj)
)
)
)
lst
)
;; Updated component blocks nested blocks inserted unselected
(setq ss
(ssget "_X"
(cons '(0 . "INSERT")
(mapcar '(lambda (x) (cons 2 (strcat "~" x))) lst)
)
)
)
(if ss
(repeat (setq nb (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq nb (1- nb))))
name (vla-get-Name obj)
bloc (vla-item (vla-get-blocks AcDoc) name)
)
(vlax-for ent bloc
(if (and (= (vla-get-ObjectName ent) "AcDbBlockReference")
(member (vla-get-Name ent) lst)
)
(progn
(sub_upd ent bloc)
(scl_upd ent)
)
)
)
)
)
;; Unlock locked layers
(if clq_lst
(mapcar '(lambda (x)
(vla-put-lock x :vlax-true)
)
clq_lst
)
)
(vla-Regen AcDoc acAllViewports)
)
;;;******************************************************************* ;;;
;; Dialog
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
m:err *error*
*error* e_b_err
)
(vla-StartUndoMark AcDoc)
(setq dcl_id (load_dialog "Edit_bloc.dcl")
loop 2
u_lst (list "None units" "Inches"
"Feet" "Miles"
"Millimeters" "Centimeters"
"Meters" "Kilometers"
"MicroInches" "Milles"
"Yards" "Angstroms"
"Nanometers" "Microns"
"Decimeters" "Decameters"
"Hectometers" "Gigameters"
"Astronomic units"
"Parsecs"
)
)
(vlax-for l (vla-get-Layers AcDoc)
(or (wcmatch (vla-get-Name l) "*|*")
(setq l_lst (cons (vla-get-Name l) l_lst))
)
)
(setq l_lst (acad_strlsort l_lst))
(vlax-for lt (vla-get-LineTypes AcDoc)
(setq lt_lst (cons (vla-get-Name lt) lt_lst))
)
(setq lt_lst (reverse lt_lst))
(setq lw_lst '("ByLayer" "ByBlock" "Default"
"0.00 mm" "0.05 mm" "0.09 mm"
"0.13 mm" "0.15 mm" "0.18 mm"
"0.20 mm" "0.25 mm" "0.30 mm"
"0.35 mm" "0.40 mm" "0.45 mm"
"0.50 mm" "0.53 mm" "0.60 mm"
"0.70 mm" "0.80 mm" "0.90 mm"
"1.00 mm" "1.06 mm" "1.20 mm"
"1.40 mm" "1.58 mm" "2.00 mm"
"2.11 mm"
)
)
(while (<= 2 loop)
(if (not (new_dialog "edit_bloc_3" dcl_id))
(exit)
)
(start_list "unt")
(mapcar 'add_list u_lst)
(end_list)
(start_list "lay_l")
(mapcar 'add_list l_lst)
(end_list)
(start_list "tl_l")
(mapcar 'add_list lt_lst)
(end_list)
(start_list "el_l")
(mapcar 'add_list lw_lst)
(end_list)
(setq w (dimx_tile "i_col")
h (dimy_tile "i_col")
)
(or dis (setq dis 0))
(start_image "i_col")
(fill_image 0 0 w h dis)
(vector_image 0 0 w 0 -18)
(vector_image 0 0 0 h -18)
(vector_image w h w 0 -18)
(vector_image w h 0 h -18)
(end_image)
(or lay (setq lay 0))
(or col (setq col '((62 . 0))))
(or tl (setq tl 0))
(or el (setq el 1))
(or plt (setq plt 0))
(setq ind (cdr (assoc 62 col))
rgb (cdr (assoc 420 col))
cnm (cdr (assoc 430 col))
)
(and tbl (set_tile "tbl" "1"))
(and all (set_tile "all" "1"))
(and sel (set_tile "sel" "1"))
(set_tile "t_col"
(cond
(cnm
(substr cnm (+ 2 (vl-string-position 36 cnm)))
)
(rgb
(strcat (itoa (lsh rgb -16))
","
(itoa (lsh (lsh rgb 16) -24))
","
(itoa (lsh (lsh rgb 24) -24))
)
)
(T
(cond
((= ind 256) "ByLayer")
((= ind 0) "ByBlock")
((= ind 1) "Red")
((= ind 2) "Yellow")
((= ind 3) "Green")
((= ind 4) "Cyan")
((= ind 5) "Blue")
((= ind 6) "Magenta")
((= ind 7) "white")
((strcat "Color " (itoa ind)))
)
)
)
)
(cond
((< 16.1 (read (substr (getvar "acadver") 1 4)))
(mode_tile "unt" 0)
(if (not unt)
(setq unt (getvar "INSUNITS"))
)
)
(T
(mode_tile "unt" 1)
(setq unt nil)
)
)
(if unt
(set_tile "unt" (itoa unt))
(set_tile "unt" (itoa (getvar "INSUNITS")))
)
(if (not (or ss tbl))
(mode_tile "accept" 1)
)
(if (zerop (getvar "PSTYLEMODE"))
(mode_tile "plt" 0)
(progn
(mode_tile "plt" 1)
(mode_tile "plt_db" 1)
(mode_tile "plt_dc" 1)
(setq plt nil)
)
)
(if e_scl
(progn
(set_tile "scl" "1")
(mode_tile "fact" 0)
)
(progn
(set_tile "scl" "0")
(mode_tile "fact" 1)
)
)
(if fact
(set_tile "fact" (rtos fact))
(setq fact 1.0)
)
(if lay-p
(progn
(mode_tile "lay_l" 0)
(set_tile "lay" "1")
)
(progn
(mode_tile "lay_l" 1)
(set_tile "lay" "0")
)
)
(set_tile "lay_l" (itoa lay))
(if (equal col '((62 . 0)))
(set_tile "col_db" "1")
(set_tile "col_db" "0")
)
(if col-p
(progn
(set_tile "col" "1")
(mode_tile "col_db" 0)
(mode_tile "col_s" 0)
)
(progn
(set_tile "col" "0")
(mode_tile "col_db" 1)
(mode_tile "col_s" 1)
)
)
(if tl-p
(progn
(mode_tile "tl_l" 0)
(set_tile "tl" "1")
)
(progn
(mode_tile "tl_l" 1)
(set_tile "tl" "0")
)
)
(set_tile "tl_l" (itoa tl))
(if el-p
(progn
(mode_tile "el_l" 0)
(set_tile "el" "1")
)
(progn
(mode_tile "el_l" 1)
(set_tile "el" "0")
)
)
(set_tile "el_l" (itoa el))
(if plt-p
(progn
(set_tile "plt" "1")
(mode_tile "plt_r" 0)
)
(progn
(set_tile "plt" "0")
(mode_tile "plt_r" 1)
)
)
(set_tile "plt_db" (itoa lay))
(action_tile
"tbl"
"(if (= \"1\" $value)
(progn (setq ss nil
tbl T all nil sel nil)
(mode_tile \"ss\" 1)
(mode_tile \"accept\" 0)))"
)
(action_tile
"all"
"(if (= \"1\" $value)
(progn
(setq ss (ssget \"_X\" '((0 . \"INSERT\")))
all T sel nil tbl nil)
(mode_tile \"ss\" 1)
(mode_tile \"accept\" 0)))"
)
(action_tile
"sel"
"(if (= \"1\" $value)
(progn (mode_tile \"ss\" 0)
(setq sel T all nil tbl nil)
(mode_tile \"ss\" 2)
(mode_tile \"accept\" 1))
(mode_tile \"accept\" 0))"
)
(action_tile
"ss"
"(progn (done_dialog 3) (mode_tile \"accept\" 0))"
)
(action_tile
"scl"
"(if (= \"1\" $value)
(progn (setq e_scl T)
(mode_tile \"fact\" 0))
(progn (setq e_scl nil)
(mode_tile \"fact\" 1)))"
)
(action_tile
"fact"
"(if (< 0 (atof $value))
(setq fact (atof $value))
(progn (alert \"Invalid input\")
(mode_tile \"fact\" 2)))"
)
(action_tile "unt" "(setq unt (atoi $value))")
(action_tile
"lay"
"(if (= \"1\" $value)
(progn
(setq lay-p T)
(setq lay (atoi (get_tile \"lay_l\")))
(mode_tile \"lay_l\" 0))
(progn (setq lay-p nil)
(mode_tile \"lay_l\" 1)))"
)
(action_tile "lay_l" "(setq lay (atoi $value))")
(action_tile
"col"
"(if (= \"1\" $value)
(progn
(setq col-p T)
(mode_tile \"col_db\" 0)
(mode_tile \"col_s\" 0))
(progn
(mode_tile \"col_db\" 1)
(mode_tile \"col_s\" 1)))"
)
(action_tile
"col_db"
"(if (= \"1\" $value)
(progn
(setq col '((62 . 0)) dis 0)
(set_tile\"col_db\" \"1\")
(done_dialog 5))
(done_dialog 4))"
)
(action_tile "col_s" "(done_dialog 4)")
(action_tile
"tl"
"(if (= \"1\" $value)
(progn
(setq tl-p T)
(setq tl (atoi (get_tile \"tl_l\")))
(mode_tile \"tl_l\" 0))
(progn (setq tl-p nil)
(mode_tile \"tl_l\" 1)))"
)
(action_tile "tl_l" "(setq tl (atoi $value))")
(action_tile
"el"
"(if (= \"1\" $value)
(progn
(setq el-p T)
(setq el (atoi (get_tile \"el_l\")))
(mode_tile \"el_l\" 0))
(progn (setq el-p nil)
(mode_tile \"el_l\" 1)))"
)
(action_tile "el_l" "(setq el (atoi $value))")
(action_tile
"plt"
"(if (= \"1\" $value)
(progn
(setq plt T)
(setq plt_n (atoi (get_tile \"plt_db\")))
(mode_tile \"plt_r\" 0))
(progn (setq plt nil)
(mode_tile \"plt_r\" 1)))"
)
(action_tile
"plt_r"
"(setq plt_n (atoi (get_tile \"plt_db\")))"
)
(action_tile "accept" "(done_dialog 1)")
(setq loop (start_dialog))
(cond
((= loop 3)
(or
(and (= (getvar "PICKFIRST") 1)
(setq ss (ssget "_I" '((0 . "INSERT"))))
)
(setq ss (ssget '((0 . "INSERT"))))
)
)
((= loop 4)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(and (setq col (acad_colordlg 0))
(setq col (list (cons 62 col)))
)
(setq col (acad_truecolordlg '(62 . 0)))
)
(setq dis (cdr (assoc 62 col)))
)
((= loop 1)
(edit_bl)
)
)
)
(unload_dialog dcl_id)
(vla-endundomark AcDoc)
(setq *error* m:err
m:err nil
)
(princ)
)
(c:eb)

********* Edit_Bloc.dcl ***********
// Boite de dialogue du LISP EDIT_BLOC version 3.3
edit_bloc_3:dialog{
label="Redefine blocks";
:boxed_row{
label="Choose blocks";
:radio_column{
:radio_button{
label="All collection";
key="tbl";
fixed_width=true;
allow_accept=true;
}
:radio_button{
label="All references";
key="all";
fixed_width=true;
allow_accept=true;
}
:radio_button{
label="Selection";
key="sel";
value="1";
fixed_width=true;
}
}
:button{
label=" >> ";
key="ss";
fixed_width=true;
alignment=bottom;
allow_accept=true;
}
}
:boxed_column{
label="Properties to edit";
:row{
:toggle{
label= "Global scale";
key="scl";
value="0";
}
:edit_box{
key="fact";
edit_width=8;
value="1.0";
allow_accept=true;
}
}
spacer;
:popup_list{
label="Units ";
key="unt";
edit_width=16;
}
spacer;
:row{
:column{
:toggle{
label="Layer";
key="lay";
fixed_width=true;
allow_accept=true;
}
spacer_1;
:toggle{
label="Color";
key="col";
fixed_width=true;
allow_accept=true;
}
spacer_1;
:toggle{
label="Line type";
key="tl";
fixed_width=true;
allow_accept=true;
}
:toggle{
label="Line weight";
key="el";
fixed_width=true;
allow_accept=true;
}
:toggle{
label="Plot style";
key="plt";
fixed_width=true;
allow_accept=true;
}
}
:column{
:popup_list{
key="lay_l";
alignment=right;
}
spacer_1;
:column{
:row{
:image{
key="i_col";
width=1;
height=1;
aspect_ratio=1.0;
}
:text{
key="t_col";
width=20;
}
}
:row{
:toggle{
label="ByBlock";
key="col_db";
value="1";
}
:button{
label="Others...";
key="col_s";
fixed_width=true;
alignment=right;
}
}
}
:popup_list{
key="tl_l";
alignment=right;
}
:popup_list{
key="el_l";
alignment=right;
}
:radio_row{
key="plt_r";
:radio_button{
label="ByBlock";
key="plt_db";
value="1";
}
:radio_button{
label="ByLayer";
key="plt_dc";
}
}
}
}
}
spacer;
ok_cancel;
}
// Dialog Scale Dynamic Blocks
alert_bloc:dialog{
label="Dynamic blocks scale";
:paragraph{
:text_part{
value="Scale changing will not change";
}
:text_part{
value="dynamic blocks parameters.";
}
}
spacer;
:boxed_column{
label="Edit block scale";
:text{
key="txt";
}
:radio_row{
:radio_button{
label="Yes";
mnemonic="O";
key="mod";
}
:radio_button{
label="No";
mnemonic="N";
key="anl";
value="1";
}
}
}
ok_only;
}

Advertisements