Topic: Get block list and rename blocks....

[KewlToyZ]

*hint*

Code: [Select]

(substr (setq dw (getvar "DWGNAME")) 1 (- (strlen dw) 4))


strlen.... thanks bro!
I'm pulling triple duty for the IT folks being out of office today, and getting ready to test a new driver with Oce' for 2010 to fix an OLE (Excel spreadsheet) plotting issue when linked or embedded in a CAD dwg file.
Catch up with you guys soon!
Your help is greatly appreciated sirs!

[gile]

*hint*

Code: [Select]

(substr (setq dw (getvar "DWGNAME")) 1 (- (strlen dw) 4))


You can use vl-filename-base too:

Code: [Select]

(vl-filename-base (setq dw (getvar "DWGNAME")))

[Lee Mac]

Another:

Code: [Select]

(cadr (fnsplitl (getvar "DWGNAME")))


[KewlToyZ]

*hint*

Code: [Select]

(substr (setq dw (getvar "DWGNAME")) 1 (- (strlen dw) 4))


You can use vl-filename-base too:

Code: [Select]

(vl-filename-base (setq dw (getvar "DWGNAME")))

I tried both and it never seemed to trim the last 4 letters off:

Current File Path : C:\Documents and Settings\cmoor.KTAGROUP\Desktop\
   Stripped File Name : B09006.00_E209-later.dwg
   Current File Name : B09006.00_E209-later.dwg
   File suffix :-AEC-REMOVED
   New file name : B09006.00_E209-later.dwg-AEC-REMOVED
   New file to Open :
C:\Documents and
Settings\cmoor.KTAGROUP\Desktop\B09006.00_E209-later.dwg-AEC-REMOVED

Code: [Select]

  (setq myPath (getvar "DWGPREFIX"))
  (princ "\n   Current File Path : ")
  (princ myPath)
 
  ;(setq myFile (getvar "DWGNAME"))
  ;(princ "\n   Current File Name : ")
  ;(princ myFile)
 
  (setq newlen (- (strlen myFile) 4))
  (substr myFile 1 newlen)
  (princ "\n   Stripped File Name : ")
  (princ myFile)
 
  ;(substr (setq myFile (getvar "DWGNAME")) 1 (- (strlen myFile) 4))
 
  ;(setq myFile (getvar "DWGNAME"))
  (princ "\n   Current File Name : ")
  (princ myFile)
  (princ "\n   File suffix :")
  (setq newSuffix (strcase "-AEC-Removed"))
  (princ newSuffix)
  (setq newName (strcat myFile newSuffix))
  (princ "\n   New file name : ")
  (princ newName)
  (setq newFile (strcat myPath newName))
  (princ "\n   New file to Open :\n")
  (princ newFile)
  (princ "\n continue.....")

[CAB]

Code: [Select]

  (setq myPath (getvar "DWGPREFIX"))
  (princ "\n   Current File Path : ")
  (princ myPath)
 
  (setq myFile (getvar "DWGNAME"))
  (princ "\n   Current File Name : ")
  (princ myFile)
 
  (princ "\n   Stripped File Name : ")
  (princ (vl-filename-base myFile))

  (princ "\n   File suffix :")
  (setq newSuffix (strcase "-AEC-Removed"))
  (princ newSuffix)
  (setq newName (strcat myFile newSuffix))
  (princ "\n   New file name : ")
  (princ newName)
  (setq newFile (strcat myPath newName))
  (princ "\n   New file to Open :\n")
  (princ newFile)
  (princ "\n   Locating New file to Open :\n")
  (if (findfile newFile) (princ "File found.")(princ "Could not locate file."))
  (princ "\n continue.....")

[KewlToyZ]

Thanks CAB,

I ran into some issues with Opening a file and found the solution pretty easily for it.

Finished routine works well so far:

Code: [Select]

; AEC removal routine for file repairs and management.
; Special thanks to CAB, Lee Mac, & Gile in the swamp for their incredible help
; http://www.theswamp.org/index.php?topic=29839.0;all
; 8-12-2009
(defun c:aec()
(vl-load-com)
;===========================================================================Turn off command line responses
(command "CMDECHO" 0)
;===========================================================================

(command "TILEMODE" 1)
(command "Zoom" "Extents")
(command "qsave")
(command "Undo" "Begin")
; rem out for speed
;(command "audit" "y")
;(command "qsave")
(princ "\n   File purge begin........")
(setq doc (vla-get-ActiveDocument
            (vlax-get-acad-object)))

(repeat 3 (vla-purgeall doc))
(princ "\n   File purge complete.")
(command "saveas" "2007" "" "y")

 
(defun unloadxrefs (/ blks)

  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk blks
    (if (equal (vla-get-isxref blk) :vlax-true)
      (progn (vla-unload blk)
             (princ (strcat "\n   Unloading XREF : " (vla-get-name blk) ".....next"))
      )
    )
  )
  (princ "\n   XREF Unloading complete!!!\n")
  (princ)
) 
(unloadxrefs) 
;============================================== begin file name structure
(setq myPath (getvar "DWGPREFIX"))
(princ "\n   Current File Path : ")
(princ myPath)
 
(setq myFile (getvar "DWGNAME"))
(princ "\n   Current File Name : ")
(princ myFile)
 
(princ "\n   Stripped File Name : ")
(setq strippedFile (vl-filename-base myFile))
(princ strippedFile)

(princ "\n   File suffix :")
(setq newSuffix (strcase "-AEC-Removed"))
(princ newSuffix)

(princ "\n   File Extension :")
(setq newExtension (strcase ".dwg"))
(princ newExtension)

(setq newName (strcat strippedFile newSuffix newExtension))
(princ "\n   New file name : ")
(princ newName)

(setq newFile (strcat myPath newName))
(princ "\n   New file to Open :\n")
(princ newFile)


(princ "\n   continue to Export.....\n")

(alert "\n *-----------------------AEC Objects will be removed.--------------------------*
\n 1.) XREF's may require purging due to nesting of AEC objects.
\n 2.) You will find your file with the '-AEC-Removed' suffix in the filename.
\n 3.) Over-write the orginal files with the new one to clear the problematic objects.
\n 4.) File will be opened once export is complete.
\n 5.) Make sure the original file is closed so you can over write it.
\n 6.) Reload all XREF's with the RAX command if necessary."
)


(command "-exporttoautocad")
(command "Prefix" ".")
(command "Suffix")
(command newSuffix)
(command "Bind")
(command "No" "" "")

;=================================== Undo & save to leave original file as found
(command "Undo" "End")
(command "Undo" "Back" "Y")
(command "saveas" "2007" "" "y")
;(command "qsave")
;===================================
(princ "\n   Locating New file to Open :\n")
(if (= (findfile newFile) nil)
(alert "\n Could not locate file.")
) ; end if

(defun OpenFile ()
(vla-open
(vla-get-documents
(vla-get-application (vlax-get-acad-object))
)
newFile
)
) ;_defun

(OpenFile)
(princ "\n   File open successful!!")
(command "close")
;===========================================================================Turn on command line responses
(setvar "CMDECHO" 1)
;===========================================================================
(princ)
)

But I found it still doesn't solve the long symbol names error in this file preventing export.
So I am back to looking at block renaming to see if it solves the problem.
I tried renaming manually, and the aecb blocks returned to their original names unfortunately. :ugly:

[Lee Mac]

Just to offer a quick alternative, you could use this to purge also:

Code: [Select]

(setq doc (vla-get-ActiveDocument
            (vlax-get-acad-object)))

(repeat 3 (vla-purgeall doc))

 

[KewlToyZ]

Thanks Lee, I put it in the code above 

[KewlToyZ]

Hmmm one of those odd things that bother me,
I try from the command line to reload all XREF's.
If one is found the command errors and discontinues instead of moving on through the list.

Command:
-XREF
Enter an option [?/Bind/Detach/Path/Unload/Reload/Overlay/Attach] <Attach>: R

Enter xref name(s) to reload: *

Reload Xref "Zbased9": ..\XREF\Zbased9.dwg
"Zbased9.dwg" cannot be found.
*Invalid*
Command:

I try the same thing here and get the same result.
I don't mind if it tells me a file is missing,
I just want it to continue repeating through the list until done.
so if blk is xref it reloads but where do I check if exist to prevent it from erroring?
Use findfile again?

Code: [Select]

(defun c:rax (/ blks)
(vl-load-com)
  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk blks
    (if (equal (vla-get-isxref blk) :vlax-true)
      (progn (vla-reload blk)
             (princ (strcat "\n   Reloading XREF : " (vla-get-name blk) ".....next"))
      )  ; end progn
    ) ; end if
  )
  (princ "\n XREF reloading complete!!!\n")
  (princ)
)

[KewlToyZ]

Not applicable...

Code: [Select]

(defun c:rax (/ blks)
(vl-load-com)
  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk blks
    (if (= (vla-get-isxref blk) :vlax-true)
(if (= (findfile blk) nil)
(alert "\n Could not locate file.")
) ; end if
      (progn (vla-reload blk)
             (princ (strcat "\n   Reloading XREF : " (vla-get-name blk) ".....next"))
      )  ; end progn
    ) ; end if
  )
  (princ "\n XREF reloading complete!!!\n")
  (princ)
)

[KewlToyZ]

Hmmmmm, not quite sure how to frame it yet.

Code: [Select]

(defun c:rax (/ blks)
(vl-load-com)
  (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk blks
    (if (and (= (vla-get-isxref blk) :vlax-true)(vlax-method-applicable-p (vla-reload blk)))     
      ;(vlax-method-applicable-p WhatsMyLine "AddBox")
      ;(vlax-method-applicable-p (vla-reload blk))
      (progn
      (vla-reload blk)
      (princ (strcat "\n   Reloading XREF : " (vla-get-name blk) ".....next"))
      )  ; end progn
    ) ; end if
  )
  (princ "\n XREF reloading complete!!!\n")
  (princ)
)

[Lee Mac]

Perhaps this may help you 

Code: [Select]

[color=RED]([/color][color=BLUE]defun[/color] xrReload [color=RED]([/color][color=RED])[/color]
 
  [color=RED]([/color][color=BLUE]vlax-for[/color] Obj [color=RED]([/color][color=BLUE]vla-get-Blocks[/color]
                  [color=RED]([/color][color=BLUE]vla-get-ActiveDocument[/color]
                    [color=RED]([/color][color=BLUE]vlax-get-acad-object[/color][color=RED])[/color][color=RED])[/color][color=RED])[/color]

    [color=#990099];; Get hold of the block collection for[/color]
    [color=#990099];; the active document and iterate through it.[/color]

    [color=#990099];; Note:-[/color]
    [color=#990099];; To make the program faster, set the ActiveDocument Object[/color]
    [color=#990099];; to a variable defined in the main function, and use it in[/color]
    [color=#990099];; the sub-function to save calling vlax-get-acad-object multiple[/color]
    [color=#990099];; times.[/color]

    [color=RED]([/color][color=BLUE]if[/color] [color=RED]([/color][color=BLUE]eq[/color] [color=blue]:vlax-true[/color] [color=RED]([/color][color=BLUE]vla-get-IsXRef[/color] Obj[color=RED])[/color][color=RED])[/color]
     
      [color=#990099];; Check Block is an XRef[/color]

      [color=RED]([/color][color=BLUE]if[/color] [color=RED]([/color][color=BLUE]vl-catch-all-error-p[/color]
            [color=RED]([/color][color=BLUE]vl-catch-all-apply[/color] [color=DARKRED]'[/color][color=BLUE]vla-reload[/color] [color=RED]([/color][color=BLUE]list[/color] Obj[color=RED])[/color][color=RED])[/color][color=RED])[/color]

        [color=#990099];; Use vl-catch-all-apply to trap any errors that[/color]
        [color=#990099];; may occur, and prevent program from crashing![/color]
       
        [color=RED]([/color][color=BLUE]princ[/color]
          [color=RED]([/color][color=BLUE]strcat[/color] [color=#ff00ff]"\n** "[/color] [color=RED]([/color][color=BLUE]vla-get-Name[/color] Obj[color=RED])[/color] [color=#ff00ff]" Failed to Reload **"[/color][color=RED])[/color][color=RED])[/color][color=RED])[/color][color=RED])[/color][color=RED])[/color]

        [color=#990099];; Notify of an error during reloading.[/color]

  [color=RED]([/color][color=BLUE]princ[/color][color=RED])[/color][color=RED])[/color]


 
     


[KewlToyZ]

Thanks Lee Mac,
I was going back to the catch all apply and reading through it but i wasn't sure on the order of where to place the error trap.
I'll read this through. Sooner or later I need to get it in my head for the order. I keep stumbling because blocks apply to xref's too.

I was back to the block renaming and I keep getting an error on a simple strcat that is just blowing my progress.

Code: [Select]

(defun c:BLR()
;===========================================================================Turn off command line responses
;(command "CMDECHO" 0)
;===========================================================================

(if (setq AllBlocks (ssget "_X" '((0 . "INSERT")))) ; begin if

(progn
(setq NumBlocks (sslength AllBlocks))
(setq Count 0)
(princ "\n   Total Blocks found : ")
(princ NumBlocks)

(repeat NumBlocks ;;this cycles number of items
(setq Ename (ssname AllBlocks Count))  ;;get entity name
(setq Edata (entget Ename))   

(setq Count (+ 1 Count))
(princ "\n\n   Count : ")
(princ Count)
(princ " of ")
(princ Numblocks)
(princ "\n\n   Edata :")
(princ Edata)

(princ "\n\n ------------- cdr assoc 2 data ------------\n")
(setq bName (cdr(assoc 2 Edata)))
(princ bName)
(princ "\n=============================================\n")

(setq nPrefix (strcase "Block-"))
(princ "\n   nPrefix : ")
(princ nPrefix)

(setq rName (strcat nPrefix Count))
(princ "\n   rName :")
(princ rName)

(princ "\n   Block found!! Please Wait......") ;amusement
(princ "\n Count = [ ")
(princ Count)
(princ " ] sorting next.....\n :")

;(princ rName)
(princ "\n   Renaming block found....")
(command "-rename" "block" bName rName )

  )

 ) ;then
 (prompt "\n   No Block objects found!") ;else
 )
(princ)
;===========================================================================Turn on command line responses
;(setvar "CMDECHO" 1)
;===========================================================================
)

it errors here

Command: blr

   Total Blocks found : 42

   Count : 1 of 42

   Edata (-1 . <Entity name: 7eb22af0>) (0 . INSERT) (330 . <Entity name:
7eb51c10>) (5 . 1C6) (100 . AcDbEntity) (67 . 0) (410 . Model) (8 . E-FIRE-E)
(100 . AcDbBlockReference) (66 . 1) (2 . kta_efi006) (10 2263.99 1794.52 0.0)
(41 . 96.0) (42 . 96.0) (43 . 96.0) (50 . 0.785398) (70 . 0) (71 . 0) (44 .
0.0) (45 . 0.0) (210 0.0 0.0 1.0))

 ------------- cdr assoc 2 data ------------
kta_efi006
=============================================

   nPrefix : BLOCK-; error: bad argument type: stringp 1

Command:

I don't get why it stops there.

[Lee Mac]

Ok, I haven't gone through it with a fine toothed comb, but I can see some obvious stuff already:

1. Make sure you localise your variables, (good programming practice).
2. You are supplying princ with data types that are not STRINGS, either convert the data to a STRING (perhaps using something like "itoa" or "rtos"), or look into the prin1 or print functions. Also, you could use strcat a lot more.

Code: [Select]

(defun c:BLR  (/ Allblocks num count ename edata bname nprefix rname)
  ;; Localise your variables buddy, good programming practice. :)
 
  (if (setq AllBlocks (ssget "_X" '((0 . "INSERT")))) ; begin if

    (progn
      (setq num (sslength AllBlocks) Count 0)
     
      (princ (strcat "\n   Total Blocks found : " (itoa num)))
     
      ;; This is where your program was failing, remember,
      ;; "princ" requires a STRING, you supplied it with an
      ;; INTEGER.

      (repeat num
        ;;this cycles number of items
       
        (setq Ename (ssname AllBlocks Count))
        ;;get entity name
        (setq Edata (entget Ename))

        (setq Count (+ 1 Count))
        (princ "\n\n   Count : ")
        (print Count)
        (princ " of ")
        (print Numblocks)
        (princ "\n\n   Edata :")
        (print Edata)

        (princ "\n\n ------------- cdr assoc 2 data ------------\n")
        (setq bName (cdr (assoc 2 Edata)))
        (print bName)
        (princ "\n=============================================\n")

        (setq nPrefix (strcase "Block-"))
        (princ "\n   nPrefix : ")
        (princ nPrefix)

        (setq rName (strcat nPrefix (itoa Count)))
        (princ "\n   rName :")
        (princ rName)

        (princ "\n   Block found!! Please Wait......") ;amusement
        (princ "\n Count = [ ")
        (print Count)
        (princ " ] sorting next.....\n :")

  ;(princ rName)
        (princ "\n   Renaming block found....")
        (command "-rename" "block" bName rName)

        )

      ) ;then
    (prompt "\n   No Block objects found!") ;else
    )
  (princ)
  ;===========================================================================Turn on command line responses
  ;(setvar "CMDECHO" 1)
  ;===========================================================================
  )





[KewlToyZ]

Thanks again Lee.
I had long forgotten the basics of c in Autolisp with princ vs. print.

I notice in conditional statements the variation of (equal, (eq, (=
Is there a significance about these, I was going to look it up in the help files but I thought I would ask.

Localising variables is still something I need to read through about the exact rules regarding their order and whn they need localised and when not to.