Author Topic: Unlock all layers within a DBX routine  (Read 1649 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
Unlock all layers within a DBX routine
« on: September 10, 2008, 10:40:32 AM »
I need to learn this vlisp stuff...but for now can anyone help with the following request.

Original routine by Tim Willey who wrote the xref repath routine for me (see link).
http://www.theswamp.org/index.php?topic=11202.0

My question is, because the routine is using objectdbx where a command cannot be used, only vlisp...
so who would I add the unlocking of locked layers when comprising the list of drawings that need
to be repath? The repath process does not work for locked layers, and stops when it incounters the
first locked layer.

Here is the routine that I would like modified:
Code: [Select]
;;;coded for Gary Fowler by Tim Willey 7/21/06

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun RepathXrefit  (/ *error* OldPath NewPath DwgList dbxApp Opened)
  (defun *error*  (msg)
    (prompt (strcat "\n  Error--> " msg))
    (if Opened
      (close Opened))
    (if dbxApp
      (progn (vlax-release-object dbxApp) (setq dbxApp nil))))
    ;-------------------------------------------------------------------------------------------
  (defun Directory-Dia (Message / sh folder folderobject result)
    ;; By Tony Tanzillo
    ;; Modified by Tim Willey
    (vl-load-com)
    (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
    (setq folder (vlax-invoke-method
   sh
   'BrowseForFolder
   (vla-get-HWND (vlax-get-Acad-Object))
   Message
   0))
    (vlax-release-object sh)
    (if folder
      (progn (setq folderobject (vlax-get-property folder 'Self))
     (setq result (vlax-get-property FolderObject 'Path))
     (vlax-release-object folder)
     (vlax-release-object FolderObject)
     (if (/= (substr result (strlen result)) "\\")
       (setq result (strcat result "\\"))
       result))))
    ;----------------------------------------------------------------------------
  (defun StringReplace (OldStr NewStr String / StPos)
    (if (setq StPos (vl-string-search OldStr String))
      (if (equal StPos 0)
(strcat NewStr (substr String (1+ (strlen OldStr))))
(strcat (substr String 1 StPos)
NewStr
(substr String (+ StPos (1+ (strlen OldStr))))))))
    ;----------------------------------------------------------------------------
  (defun RePathXref  (Doc OldDir NewDir / SaveChanges OldPath NewPath DwgName)
    (if (not ARCH#LOGO)
      (setq ARCH#LOGO " Your Logo"))
    (vlax-for
   Lo  (vla-get-Layouts Doc)
      (vlax-for
     Obj  (vla-get-Block Lo)
(if (and (= (vla-get-ObjectName Obj) "AcDbBlockReference")
(vlax-property-available-p Obj 'Path)
(setq CurPath (vla-get-Path Obj))
(write-line (strcat "  Xref name: " (vla-get-Name Obj)) Opened)
(write-line (strcat "    Xref path old " (vla-get-Path Obj)) Opened)
(setq NewPath (StringReplace OldDir NewDir CurPath)))
  (progn (vla-put-Path Obj NewPath)
(write-line (strcat "    Xref path new " (vla-get-Path Obj)) Opened)
(setq SaveChanges T)))))
    (if SaveChanges ; (SaveAsEx (vla-get-Name Doc))
      (vla-SaveAs Doc (vla-get-Name Doc))))
    ;-----------------------------------------------------------------------------------
  (if (and (setq OldPath
  (Directory-dia
    (strcat
      ARCH#LOGO
      " : Select OLD path of Drawings to Repath\n\t\t  Repath Xrefs of all drawings in folder.\n\t\t  By: Tim Willey")))
   (setq NewPath
  (Directory-dia
    (strcat
      ARCH#LOGO
      " : Select NEW path of Drawings to Repath\n\t\t  Repath Xrefs of all drawings in folder.\n\t\t  By: Tim Willey")))
   (setq DwgList (vl-directory-files NewPath "*.dwg" 1))
   (setq dbxApp
  (if (< (atoi (setq oVer (substr (getvar "acadver") 1 2))) 16)
    (vla-GetInterfaceObject (vlax-get-acad-object) "ObjectDBX.AxDbDocument")
    (vla-GetInterfaceObject
      (vlax-get-acad-object)
      (strcat "ObjectDBX.AxDbDocument." oVer))))
   (setq Opened (open (strcat NewPath "RepathXref.txt") "a")))
    (foreach
   Dwg DwgList
      (setq SaveChanges nil)
      (if (vl-catch-all-error-p
    (vl-catch-all-apply 'vla-Open (list dbxApp (strcat Newpath Dwg))))
(write-line (strcat "\n+++ Could not open \"" NewPath Dwg "\"") Opened)
(progn (write-line (strcat " - Drawing \"" NewPath Dwg "\" report") Opened)
       (RePathXref dbxApp OldPath NewPath)))))
  (if Opened
    (progn (close Opened)
   (initget "Yes No")
   (if (= (getkword "\n Open log file [<Y>es/No]: ") "No")
     (prompt (strcat "n Log file location: " NewPath "RepathXref.txt"))
     (startapp "notepad.exe" (strcat NewPath "RepathXref.txt")))))
  (if dbxApp
    (progn (vlax-release-object dbxApp) (setq dbxApp nil)))
  (princ))

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2081
Re: Unlock all layers within a DBX routine
« Reply #1 on: September 10, 2008, 11:07:29 AM »
To make it simpler, all I need to do is unlock layer "0-XREF" using vlisp for only those drawings to be process list.

Thanks

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Unlock all layers within a DBX routine
« Reply #2 on: September 10, 2008, 11:08:58 AM »
This should do what you want Gary.

Code: [Select]
  (defun RePathXref  (Doc OldDir NewDir / SaveChanges OldPath NewPath DwgName [color=red]LockedLayList[/color])
    (if (not ARCH#LOGO)
      (setq ARCH#LOGO " Your Logo"))
[color=red]        (vlax-for i (vla-get-Layers Doc)
            (if (equal (vla-get-Lock i) :vlax-true)
                (progn
                    (setq LockedLayList (cons i LockedLayList))
                    (vla-put-Lock i :vlax-false)
                )
            )
        )[/color]
    (vlax-for
   Lo  (vla-get-Layouts Doc)
      (vlax-for
     Obj  (vla-get-Block Lo)
(if (and (= (vla-get-ObjectName Obj) "AcDbBlockReference")
(vlax-property-available-p Obj 'Path)
(setq CurPath (vla-get-Path Obj))
(write-line (strcat "  Xref name: " (vla-get-Name Obj)) Opened)
(write-line (strcat "    Xref path old " (vla-get-Path Obj)) Opened)
(setq NewPath (StringReplace OldDir NewDir CurPath)))
  (progn (vla-put-Path Obj NewPath)
(write-line (strcat "    Xref path new " (vla-get-Path Obj)) Opened)
(setq SaveChanges T)))))
[color=red]    (foreach i LockedLayList
        (vla-put-Lock i :vlax-true)
    )[/color]
    (if SaveChanges ; (SaveAsEx (vla-get-Name Doc))
      (vla-SaveAs Doc (vla-get-Name Doc))))
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Unlock all layers within a DBX routine
« Reply #3 on: September 10, 2008, 11:21:18 AM »
Man that was fast. Thank you Sir Tim.

I just tested it...PERFECT.

Thanks again.

Gary

Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Unlock all layers within a DBX routine
« Reply #4 on: September 10, 2008, 11:25:48 AM »
Man that was fast. Thank you Sir Tim.

I just tested it...PERFECT.

Thanks again.

Gary


Good to hear.  You're welcome Gary.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.