Jump to content

rename block


hosyn

Recommended Posts

  • Replies 23
  • Created
  • Last Reply

Top Posters In This Topic

  • neophoible

    7

  • BlackBox

    5

  • alanjt

    4

  • hosyn

    4

Top Posters In This Topic

how can rename block in drawing by lisp.

 

am using this old routine but still does the job...

 

;; RBLOCK.lsp  v1.0
;;
;; Copyright (c) 1998 by Innovative Programming
;; All Rights Reserved
;;
;; TERMS & AGREEMENT
;;   Permission to use, copy, modify, and distribute this software
;;   for any purpose and without fee is hereby granted, provided
;;   that the above copyright notice appears in all copies and that
;;   both copyright notice and this permission notice appears in
;;   all supporting documentation.
;;
;;   ANY USE OF THIS SOFTWARE IS AT YOUR OWN RISK AND IT IS PROVIDED
;;   "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.  ALL IMPLIED WARRANTIES
;;   OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF MERCHANTABILITY ARE
;;   HEREBY DISCLAIMED.  NO LIABILITY FOR CONSEQUENTIAL DAMAGES.  IN NO
;;   EVENT SHALL INNOVATIVE PROGRAMMING BE LIABLE FOR INCIDENTAL,
;;   INDIRECT, OR CONSEQUENTIAL DAMAGES (INCLUDING, WITHOUT LIMITATION,
;;   DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS
;;   OF BUSINESS INFORMATION, OR ANY OTHER PECUNIARY LOSS) AS A RESULT
;;   OF THE USE OF OR INABILITY TO USE THIS SOFTWARE.
;;
;; PURPOSE:
;;   Rename user selected block.
;;
;; OTHER NOTES:
;;   None
;;
;; FUTURE REVISIONS:
;;   None
;;
;; REVISIONS:
;;   1.0  9/14/98  Released
;;
(defun C:RBLOCK (/ SB SBD OLD_NAME NEW_NAME)
 (setq SB NIL)
 (while (null SB)
   (setq SB (entsel "\nSelect block to RENAME: "))
   (if SB
     (progn (setq SB  (car SB)
                  SBD (entget SB)
            )
            (if (= (cdr (assoc 0 SBD)) "INSERT")
              (redraw SB)
              (progn (redraw SB)
                     (setq SB NIL)
                     (princ "\nItem selected is not a block.")
              )
            )
     )
     (princ "\nNothing selected.  Try again.")
   )
 )
 (setq OLD_NAME (cdr (assoc 2 SBD)))
 (princ (strcat "\n OLD Block Name: " OLD_NAME))
 (setq NEW_NAME (getstring "\n NEW Block Name: "))
 (command "rename" "b" OLD_NAME NEW_NAME)
 (princ (strcat "\n BLOCK RENAMED TO: " NEW_NAME))
 (princ)
)
(princ "\nRBLOCK Loaded.  Type RBLOCK to Start.")
(princ)

Link to comment
Share on other sites

My version, also for Dynamic&Anonymous blocks. :)

 

;;; file: RB_en.lsp                                                 ;;;
;;; data: 22/10/2008                                                ;;;
;;; note: Rename the selected block.                                ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 2) - 01/04/2009                        ;;;
;;;              - default sulla casella OK                         ;;;
;;;              - controllo esistenza nome blocco                  ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 3) - 02/04/2009                        ;;;
;;;              - allargata casella editazione nome blocco         ;;;
;;;                                                                 ;;;
;;; aggiornamento: (Versione 4) - 28/10/2012                        ;;;
;;;              - rinomina blocchi dinamici e blocchi anonimi      ;;;
;;;              - creazione di blocchi anonimi                     ;;;
;;;              - inglobamento DCL nel lisp                        ;;;
;;;                                                                 ;;;
;;; aggiornamento: (V. 4_en) - 20/05/2013                           ;;;
;;;              - English Version (for CADTutor)                   ;;;
;;;                                                                 ;;;
;;; autore: Gian Paolo Cattaneo                                     ;;;


(defun c:RB (/ :bb old new dcl_id)
   (prompt "\n ") (prompt "\n ") (prompt "\n ")
   (if
       (while (not :bb)
           (setvar 'errno 0)
           (setq :bb (car (entsel "\nSelect block to RENAME:")))
           (if (= 7 (getvar 'errno))
               (alert "Nothing selected.  Try again.")
           )
           (if (= 'ename (type :bb))
               (if (null (wcmatch (cdr (assoc 0 (entget :bb))) "INSERT"))
                   (progn
                       (alert "Item selected is not a block.")
                       (setq :bb nil)
                   )
                   (progn
                       (setq old (vla-get-effectivename (vlax-ename->vla-object :bb)))
                   )
               )
           )
       )
       (progn
           (RB_dcl)
           (while
               (and
                   (/= (strcase old) (strcase new))
                   (tblsearch "BLOCK" new)
               )
               (alert "A block with this name already exists")
               (RB_dcl)
           )
           (vla-put-Name
               (vla-item
                   (vla-get-blocks
                       (vla-get-activedocument
                           (vlax-get-acad-object)
                       )
                   )
                   old
               )
               new
           )
       )
   )
   (prompt "\n ") (prompt "\n ") (prompt "\n ")
   (princ)
)

(defun RB_dcl ( / DCLname)
   (setq DCLname (strcat (getvar 'localrootprefix) "RB_V4_en.dcl"))
   (if (not (findfile DCLname)) (crea_dcl_RB))   
   (if (= POSIZ_DCL_RB nil) (setq POSIZ_DCL_RB (list -1 -1)))   
   (setq dcl_id (load_dialog DCLname))       
   (if (not (new_dialog "RB4" dcl_id "" POSIZ_DCL_RB)) (exit))    
   (setq new old)
   (set_tile "new" new)
   (action_tile "new" "(setq new $value)")
   (start_dialog)
   (unload_dialog dcl_id)
)

(defun crea_dcl_RB (/ fn f)
   (setq fn  DCLname)
   (setq f (open fn "w"))
   (write-line "RB4:dialog {" f)
   (write-line "label = \"RB - Rename Block (Vers. 4_en)\";" f)
   (write-line "" f)
   (write-line "    initial_focus=\"new\";" f)
   (write-line "" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "" f)
   (write-line "    : text {" f)
   (write-line "    label = \"New Block Name:\";" f)
   (write-line "    alignment = centered;" f)
   (write-line "    } " f)
   (write-line "" f)
   (write-line "    : text {" f)
   (write-line "    label = \"(type:  *U  to create an Anonymous Block)\";" f)
   (write-line "    alignment = centered;" f)
   (write-line "    } " f)
   (write-line "" f)
   (write-line "    : spacer {}" f)
   (write-line "" f)    
   (write-line "    : edit_box {" f)
   (write-line "    key=\"new\";" f)
   (write-line "    allow_accept=true;" f)
   (write-line "    }" f)
   (write-line "" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "" f)
   (write-line "    ok_only;" f)
   (write-line "" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "    : spacer {}" f)
   (write-line "" f)
   (write-line "    : text { " f)
   (write-line "    label = \"Copyright  ©  2012  -  Gian Paolo Cattaneo\";" f)
   (write-line "    alignment = centered;" f)
   (write-line "    }" f)
   (write-line "" f)
   (write-line "}" f)
   (close f)
   (load_dialog fn)
)
;******************************************************************************
(vl-load-com)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ "\nRename Block (V.4_en) - by Gian Paolo Cattaneo")
(princ "\nType  RB  to Start")
(princ)

Link to comment
Share on other sites

First: is the RENAME function not good enough?
:huh:Why did you ask this? I've briefly looked at some of your related posts elsewhere. I think it's an interesting query, especially considering all the trouble you've already gone to in making it easier for folks to change block names.:thumbsup:

 

My answer to your question is No, it is not good enough in many cases. I was being driven crazy by the enormous amounts of anonymous blocks I encounter that have been built on the fly. And I'm not referring to dynamic blocks here. Perhaps some of these anonymous blocks may be justified, but many are important enough to be properly named in the drawing. It's tedious to select a block to find its anonymous name, then go to the RENAME dialog, search for it in the list (I would often have to do this twice just to make sure), then rename it to something more appropriate. So, thanks, Alan, for making it so much easier to handle that sort of thing more automatically. :D Maybe you should reference or repeat your solution(s) here, perhaps with the latest version(s)?

Link to comment
Share on other sites

:huh:Why did you ask this? I've briefly looked at some of your related posts elsewhere. I think it's an interesting query, especially considering all the trouble you've already gone to in making it easier for folks to change block names.:thumbsup:
I can't answer for Alan but I think it is a fair place to start. So often we are asked for "a LISP" to do something that can be easilly accomplished using standard AutoCAD commands. You have givven a good case for something more than the RENAME command but had the OP wanted something simple he would have had the reply straight away. A lot of people here don't want to learn AutoCAD but are quite happy to ask somebody to write a routine for them.
Link to comment
Share on other sites

My answer to your question is No, [RENAME] is not good enough in many cases. I was being driven crazy by the enormous amounts of anonymous blocks I encounter that have been built on the fly. And I'm not referring to dynamic blocks here. Perhaps some of these anonymous blocks may be justified, but many are important enough to be properly named in the drawing. It's tedious to select a block to find its anonymous name, then go to the RENAME dialog, search for it in the list (I would often have to do this twice just to make sure), then rename it to something more appropriate.

 

This is in part, the motivation behind my Right Click Rename plug-in (link above)... It allows one to select a single Block (for this specific example), right click, Rename, Block, and enter the new Block name (existing block name shown/fed to the -RENAME Command for you). That's it.

 

Only the items that apply to the selected entity type are available via context menu, and only those that can be renamed are enabled within the context menu items.

 

attachment.php?attachmentid=41879&stc=1&d=1368555266

Link to comment
Share on other sites

I can't answer for Alan but I think it is a fair place to start. So often we are asked for "a LISP" to do something that can be easilly accomplished using standard AutoCAD commands. You have givven a good case for something more than the RENAME command but had the OP wanted something simple he would have had the reply straight away. A lot of people here don't want to learn AutoCAD but are quite happy to ask somebody to write a routine for them.
Yes, I quite agree. I'm usually reluctant to take it very far until I understand the question being asked. It seems rare to me to see a first post that is clear. And just so I'm clear, I wasn't trying to be critical of Alan. Far from it. In this particular case, it just happens to be a very useful thing to do via LISP, even if the OP didn't really need it. Since it's been solved already, I thought it a good thing to post or link that solution here, if Alan wants. BTW, I noticed Alan's solution on another forum, but I did not see it here on CADTutor. Perhaps I just missed it? I'm going to try to take a look at BlackBox's solution and see if I can understand it.
Link to comment
Share on other sites

This is in part, the motivation behind my Right Click Rename plug-in (link above)... It allows one to select a single Block (for this specific example), right click, Rename, Block, and enter the new Block name (existing block name shown/fed to the -RENAME Command for you). That's it.

 

Only the items that apply to the selected entity type are available via context menu, and only those that can be renamed are enabled within the context menu items.

 

I think I understand the concept just fine, I guess I just didn't see where it has actually been provided yet. It certainly looks impressive. One thing I like about these solutions is that the original name is in the New Name box. This both identifies the original block and allows for a partial edit. Very handy.
Link to comment
Share on other sites

I think I understand the concept just fine, I guess I just didn't see where it has actually been provided yet. It certainly looks impressive. One thing I like about these solutions is that the original name is in the New Name box. This both identifies the original block and allows for a partial edit. Very handy.

 

That is kind of you to say... Unfortunately, I like you, am still awaiting Autodesk staff to complete their app review so it can be published at Autodesk Exchange.

Link to comment
Share on other sites

:huh:Why did you ask this? I've briefly looked at some of your related posts elsewhere. I think it's an interesting query, especially considering all the trouble you've already gone to in making it easier for folks to change block names.:thumbsup:

 

My answer to your question is No, it is not good enough in many cases. I was being driven crazy by the enormous amounts of anonymous blocks I encounter that have been built on the fly. And I'm not referring to dynamic blocks here. Perhaps some of these anonymous blocks may be justified, but many are important enough to be properly named in the drawing. It's tedious to select a block to find its anonymous name, then go to the RENAME dialog, search for it in the list (I would often have to do this twice just to make sure), then rename it to something more appropriate. So, thanks, Alan, for making it so much easier to handle that sort of thing more automatically. :D Maybe you should reference or repeat your solution(s) here, perhaps with the latest version(s)?

 

I must say. I've never been insulted and praised, in the same post. Well done.

 

To answer your question: given how vague the original question (the one I responded to) I felt checking to see if the OP actually knew of the existence of the RENAME command. Many times over, people request a LISP for a task that can already be performed by a native command. First we learn the system, then we learn to manipulate it.

 

Now, given the additional information the OP provided on their second post, I am happy to provide code I have already written, as you have pointed out, but failed to link yourself. BTW, I'd appreciate a link, since I'd be more than happy to update, if it is out of date. I've posted a lot of code and don't really keep track of it very well.

 

I do apologize for not having looked at this sooner, but I spend the bulk of my weekends in my workshop or with the kiddies.

 

Here is my block rename function. It will allow the user to select a block entity, then specify a new name. Existing name is displayed in a popup dialog, giving the user the option to view and slightly alter the existing name, if desired. I believe I've accounted for all issues, but nothing is guaranteed. I hope this helps. :)

 

(defun c:RenB (/ obj old new)
 ;; Rename Selected Block
 ;; Required Subroutines: AT:GeSel, AT:Getstring
 ;; Alan J. Thompson, 03.10.10 / 07.15.10
 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect block to rename: "
       (lambda (x)
         (if
           (and (eq "INSERT" (cdr (assoc 0 (entget (car x)))))
                (/= 4
                    (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car x))))))) 4)
                )
           )
            (setq obj (vlax-ename->vla-object (car x)))
         )
       )
     )

     (setq old (if (vlax-property-available-p obj 'effectivename)
                 (vla-get-effectivename obj)
                 (vla-get-name obj)
               )
     )
     (not (vl-position
            (setq new (AT:GetString "Specify new block name:" old))
            (list old "" nil)
          )
     )
   )
    (cond
      ((tblsearch "BLOCK" new) (alert (strcat "\"" new "\" already exists!")))
      ((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
      ((and (snvalid new) (not (tblsearch "block" new)))
       (if
         (vl-catch-all-error-p
           (vl-catch-all-apply
             'vla-put-name
             (list
               (vla-item (vla-get-blocks
                           (cond (*AcadDoc*)
                                 ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                           )
                         )
                         old
               )
               new
             )
           )
         )
          (alert (strcat "Block: " old " could not be renamed to: " new))
          (alert (strcat "Block: " old " renamed to: " new))
       )
      )
    )
 )
 (princ)
)



(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (while
   (progn (setvar 'ERRNO 0)
          (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)



(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";"
              "initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;"
              "fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {"
              "key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}"
              "}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {"
              "width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)

Link to comment
Share on other sites

I must say. I've never been insulted and praised, in the same post. Well done.
:lol:Thank you. After 5 years, it's about time!:D Stick around, it gets better, or worse, or, well, whatever....:? (Just in case anyone missed it... None of my comments were meant to be insulting.)
To answer your question: given how vague the original question (the one I responded to) I felt checking to see if the OP actually knew of the existence of the RENAME command. Many times over, people request a LISP for a task that can already be performed by a native command. First we learn the system, then we learn to manipulate it.
Yes, agreed. I just wish I knew how to manipulate it like some folks that are newer here than I am. Oh, wait. You were talking about AutoCAD, weren't you?;)
Now, given the additional information the OP provided on their second post, I am happy to provide code I have already written, as you have pointed out, but failed to link yourself. BTW, I'd appreciate a link, since I'd be more than happy to update, if it is out of date. I've posted a lot of code and don't really keep track of it very well.
Here's where I found it. I think it's the same, though; has same dates. I didn't post it, as I was thinking (perhaps wrongly) it would be better for you to bless it, etc. Again, nice work.:thumbsup:

 

http://forums.augi.com/showthread.php?121288-Renaming-a-block-using-LISP/page2

 

I do apologize for not having looked at this sooner, but I spend the bulk of my weekends in my workshop or with the kiddies.
Well, that's not something I would accept an apology for! "Sorry, but I was keeping my priorities straight." Good for you!:) I'm sure a lot of other good folk here do the same.
Link to comment
Share on other sites

That is kind of you to say...
What can I say? You're a pro!

 

Unfortunately, I like you,
Yeah, I get that from a lot of people.:lol: (Note to those who don't get it. Don't worry about it. I'm just taking the opportunity to joke around in regard to the punctuation.)

 

am still awaiting Autodesk staff to complete their app review so it can be published at Autodesk Exchange.
Is this typically a long wait? Don't feel obligated to answer that.
Link to comment
Share on other sites

What can I say? You're a pro!

 

I've suffered the benefit of a great deal of help, from alanjt (this thread) among many others, along my relatively short journey (see my 'join date' at left, when I did not know what a Defun was).

 

Yeah, I get that from a lot of people.:lol: (Note to those who don't get it. Don't worry about it. I'm just taking the opportunity to joke around in regard to the punctuation.)

 

Now that's just sad... :rofl: What's life without a bit of levity!?!

 

 

 

:offtopic:

 

Is this typically a long wait? Don't feel obligated to answer that.

 

The short answer is... It depends.

 

In my very limited experience the answer is a definite "Yes," and that from one who has an Autodesk Developer Network (ADN) Membership.

 

Suffice it to say that my first app submission _still_ hasn't been publish yet... In short, Autodesk didn't like my calling my app "Antivirus for AutoCAD" due to their new [poorly designed] security protocol, something I've been quite critical of in the Beta forums, and politely so here, so I've renamed my app "Blacklist for AutoCAD."

 

The app finds, and 'Blacklists' files (i.e., Acad.fas) based on user-defined 'definitions' via XML file (provided), and can 'Blacklist' them prior to their being loaded in the startup sequence (some companies, use only non-compiled code, some do not, etc. hence the user-defined XML).

 

I don't mind that so much, it was the prominent ADN developer directing me that I had to prepare a list of all known AutoCAD viruses (which they've never done in 20+ years), host them on my website (which is fine), and remove all user interaction (meaning have these file names be implemented without the user knowing, or having any control; I'd be pissed!)... When AutoCAD viruses are Acad.[lsp[fas[vlx]]], and AcadDoc.[lsp[fas[vlx]]], I tend to believe the user should dictate what is, and is not to be handled. Finally, after weeks of making my case via email, I was able to get my case escalated and they removed this idiotic requirement.

 

My second app, "Right Click Rename for AutoCAD" still hasn't completed the preliminary review... Status just shows "Pending" in the queue on 'my uploads' page at Autodesk Exchange. I have several others that I've already started (like that Raster Toggle plug-in), but there is actually quite a bit of work involved before you can submit for review, so we'll see how it goes moving forward.

 

Cheers

Link to comment
Share on other sites

:lol:Thank you. After 5 years, it's about time!:D Stick around, it gets better, or worse, or, well, whatever....:? (Just in case anyone missed it... None of my comments were meant to be insulting.)

Yes, agreed. I just wish I knew how to manipulate it like some folks that are newer here than I am. Oh, wait. You were talking about AutoCAD, weren't you?;)

Here's where I found it. I think it's the same, though; has same dates. I didn't post it, as I was thinking (perhaps wrongly) it would be better for you to bless it, etc. Again, nice work.:thumbsup:

 

http://forums.augi.com/showthread.php?121288-Renaming-a-block-using-LISP/page2

 

Well, that's not something I would accept an apology for! "Sorry, but I was keeping my priorities straight." Good for you!:) I'm sure a lot of other good folk here do the same.

 

I'm just joshing you.

 

I appreciate you posting the link, which is more than acceptable. I've posted it to the public forums so it's there for the world to continue to share, if worth anything. If you do have the link, I'd prefer that to be posted, rather than another copy of the code, only to keep the least amount of versions floating around. I don't have a site, so the forums will be where you find my parens.

 

Code at provided augi link updated. Thanks for posting.

Link to comment
Share on other sites

I must say. I've never been insulted and praised, in the same post. Well done.

 

To answer your question: given how vague the original question (the one I responded to) I felt checking to see if the OP actually knew of the existence of the RENAME command. Many times over, people request a LISP for a task that can already be performed by a native command. First we learn the system, then we learn to manipulate it.

 

Now, given the additional information the OP provided on their second post, I am happy to provide code I have already written, as you have pointed out, but failed to link yourself. BTW, I'd appreciate a link, since I'd be more than happy to update, if it is out of date. I've posted a lot of code and don't really keep track of it very well.

 

I do apologize for not having looked at this sooner, but I spend the bulk of my weekends in my workshop or with the kiddies.

 

Here is my block rename function. It will allow the user to select a block entity, then specify a new name. Existing name is displayed in a popup dialog, giving the user the option to view and slightly alter the existing name, if desired. I believe I've accounted for all issues, but nothing is guaranteed. I hope this helps. :)

 

(defun c:RenB (/ obj old new)
;; Rename Selected Block
;; Required Subroutines: AT:GeSel, AT:Getstring
;; Alan J. Thompson, 03.10.10 / 07.15.10
(if
(and
(AT:GetSel
entsel
"\nSelect block to rename: "
(lambda (x)
(if
(and (eq "INSERT" (cdr (assoc 0 (entget (car x)))))
(/= 4
(logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car x))))))) 4)
)
)
(setq obj (vlax-ename->vla-object (car x)))
)
)
)

(setq old (if (vlax-property-available-p obj 'effectivename)
(vla-get-effectivename obj)
(vla-get-name obj)
)
)
(not (vl-position
(setq new (AT:GetString "Specify new block name:" old))
(list old "" nil)
)
)
)
(cond
((tblsearch "BLOCK" new) (alert (strcat "\"" new "\" already exists!")))
((not (snvalid new)) (alert (strcat "\"" new "\" is an invalid name!")))
((and (snvalid new) (not (tblsearch "block" new)))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-name
(list
(vla-item (vla-get-blocks
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
old
)
new
)
)
)
(alert (strcat "Block: " old " could not be renamed to: " new))
(alert (strcat "Block: " old " renamed to: " new))
)
)
)
)
(princ)
)



(defun AT:GetSel (meth msg fnc / ent)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(while
(progn (setvar 'ERRNO 0)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
((eq (type (car ent)) 'ENAME)
(if (and fnc (not (fnc ent)))
(princ "\nInvalid object!")
)
)
)
)
)
ent
)



(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
;; Getstring Dialog Box
;; #Title - Title of dialog box
;; #Default - Default string within edit box
;; Alan J. Thompson, 08.25.09
(setq #FileName (vl-filename-mktemp "" "" ".dcl")
#FileOpen (open #FileName "W")
)
(foreach x '("TempEditBox : dialog {" "key = \"Title\";" "label = \"\";"
"initial_focus = \"Edit\";" "spacer;" ": row {" ": column {" "alignment = centered;"
"fixed_width = true;" ": text {" "label = \"\";" "}" "}" ": edit_box {"
"key = \"Edit\";" "allow_accept = true;" "edit_width = 40;" "fixed_width = true;" "}"
"}" "spacer;" ": row {" "fixed_width = true;" "alignment = centered;" ": ok_button {"
"width = 11;" "}" ": cancel_button {" "width = 11;" "}" "}" "}//"
)
(write-line x #FileOpen)
)
(close #FileOpen)
(setq #DclID (load_dialog #FileName))
(new_dialog "TempEditBox" #DclID)
(set_tile "Title" #Title)
(set_tile "Edit" #Default)
(action_tile "accept" "(setq #NewString (get_tile \"Edit\"))(done_dialog)")
(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog #DclID)
(vl-file-delete #FileName)
#NewString
)

 

 

Great routine Alan!

thanks for sharing :)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...