TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Adesu on June 06, 2007, 02:27:59 AM
-
Hi Alls,
My brain still lock to solve my problem, I would rename alls the block in area drawing if the block contained 25 pcs or more, my code can't rename it.
(defun c:rmb (/ btyp ed ent_old etyp old opt ss
sse sse_ent_old sse_old str xstr)
(if
(setq ss (car (entsel "\nSelect an object block")))
(progn
(setq sse (entget ss))
(setq etyp (cdr (assoc 0 sse)))
(if
(= etyp "INSERT")
(progn
(setq str (cdr (assoc 2 sse)))
(setq opt (getstring t (strcat "\nEnter new name of block< " str " >: ")))
(if (= opt "")(setq opt str))
(setq ssx (ssget "x" (list (cons 0 "INSERT")
(cons 100 "AcDbBlockReference")
(cons 2 str))))
(setq ssl (sslength ssx))
(setq cnt 0)
(repeat
ssl
(setq ent (ssname ssx cnt))
(setq sse_old (entget ent))
(setq btyp (cdr (assoc 0 sse_old)))
(if
(= btyp "INSERT")
(progn
(setq xstr (cons 2 opt))
(setq ed (entmod (subst xstr (assoc 2 sse_old) sse_old)))
) ; progn
(alert "\nThis not block")
) ; if
(setq cnt (1+ cnt))
) ; repeat
) ; progn
(alert "\nInvalid insert objeck")
) ; if
) ; progn
(alert "\nInvalid selected object,please try again")
) ; if
(princ)
) ; defun
-
Try these variants:
(vl-load-com)
(or *kpblc-activedoc*
(setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of or
(defun c:vla-rename (/ ent name)
(vla-startundomark *kpblc-activedoc*)
(if
(and (not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq ent (car (entsel "\nSelect a block to be renamed")))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of not
ent
(= (cdr (assoc 0 (entget ent))) "INSERT")
(/= (substr (cdr (assoc 2 (entget ent))) 1 2) "*U")
(not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq name (getstring t
(strcat "\nEnter new name <"
(cdr (assoc 2 (entget ent)))
"> : "
) ;_ end of strcat
) ;_ end of getstring
) ;_ end of setq
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(/= (vl-string-trim " " name))
) ;_ end of and
(if (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(vla-put-name
(vla-item (vla-get-blocks *kpblc-activedoc*)
(cdr (assoc 2 (entget ent)))
) ;_ end of vla-item
name
) ;_ end of vla-put-name
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
(princ (strcat "\nCan't rename a block "
(cdr (assoc 2 (entget ent)))
" with new name "
name
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
(princ (strcat "\nA error has been catched:"
"\nSelection error | Selected entity isn't a block "
"| It's a unnamed or dynamic block"
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
(vla-endundomark *kpblc-activedoc*)
(princ)
) ;_ end of defun
By "command" method:
(defun c:com-rename ()
(command "_.-rename" "_b")
(while (/= (logand (getvar "cmdactive") 31) 0)
(command pause)
) ;_ end of while
) ;_ end of defun
(defun c:com-rename2 (/ ent name)
(if
(and (not (vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(setq ent (car (entsel "\nSelect a block to be renamed")))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of vl-catch-all-error-p
) ;_ end of not
ent
(= (cdr (assoc 0 (entget ent))) "INSERT")
(/= (substr (cdr (assoc 2 (entget ent))) 1 2) "*U")
) ;_ end of and
(progn
(command "_.rename" "_b" (cdr (assoc 2 (entget ent))))
(while (/= (logand (getvar "cmdactive") 31) 0)
(command pause)
) ;_ end of while
) ;_ end of progn
(princ (strcat "\nA error has been catched:"
"\nSelection error | Selected entity isn't a block "
"| It's a unnamed or dynamic block"
) ;_ end of strcat
) ;_ end of princ
) ;_ end of if
) ;_ end of defun
-
Hi kpblc ,
It's great special for activeX, thanks you very much for your help.
-
My code won't works with anonymous blocks. And I didn't test it with dynamic blocks (i think an EffectiveName property should be changed, but i'm not sure).