Topic: Importing Layer controls without opening drawings

[Lee Mac]

I have been working on this for a few... no such luck with calling a script. However, this is pretty powerful stuff!:)
The script is on my C root drive...

Are you unable to run the program?

Note that my program is utilising ObjectDBX to batch process all selected drawings, no AutoCAD Script (.scr) is necessary.

[MSTG007]

your program runs great and opens! I have a script file I was seeing if I could run it.

[Lee Mac]

your program runs great and opens! I have a script file I was seeing if I could run it.

What are you attempting to use the script file for?

[MSTG007]

Built kinda with the first request with the layers. What you provided above was; a way to add revision layers to a bunch of dwgs at the same time. So as it prompts for the layer name and color. (Layer name REVISION1, Color 4), next revision would happen (Layer name REVISION2, Color 4), but change (Layer name REVISION1, to color 9), and so forth with as many revisions there may need. so the Color 4 is bold and the color 9 I screened back.

[Lee Mac]

Built kinda with the first request with the layers. What you provided above was; a way to add revision layers to a bunch of dwgs at the same time. So as it prompts for the layer name and color. (Layer name REVISION1, Color 4), next revision would happen (Layer name REVISION2, Color 4), but change (Layer name REVISION1, to color 9), and so forth with as many revisions there may need. so the Color 4 is bold and the color 9 I screened back.

So presumably you would incorporate the additional operations to switch REVISION1 to colour 9 into the program I have provided - i.e. into the function argument passed to the LM:odbx function.

I am not sure if you have taken the operations from the code I have provided to use in a Script, or are attempting to call the program I have provided through a Script, but either way, a Script is not required.

[MSTG007]

Yes you are right. For me it was easier to code it under the script I do not completely understand how you the operations of your program. lol. I am trying though! lol. But as you stated above yes that is what I would like to do.

[Lee Mac]

that is what I would like to do.

OK - The following code should get you off to a good start:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / lay lst nco new oco old )
2.     (while (not (or (= "" (setq new (getstring t "\nSpecify new layer name <skip>: "))) (snvalid lay)))
3.         (princ "\nInvalid layer name.")
4.     )
5.     (if (or (= "" new) (setq nco (acad_colordlg 7 nil)))
6.         (progn
7.             (while (not (or (= "" (setq old (getstring t "\nSpecify old layer name <skip>: "))) (snvalid lay)))
8.                 (princ "\nInvalid layer name.")
9.             )
10.             (if (or (= "" old) (setq oco (acad_colordlg 7 nil)))
11.                 (if (setq lst (LM:getfiles "Select drawings to process" "" "dwg;dwt;dws"))
12.                     (LM:odbx
13.                        '(lambda ( doc / lay )
14.                             (if (/= "" new)
15.                                 (vla-put-color (vla-add (vla-get-layers doc) new) nco)
16.                             )
17.                             (if (and (/= "" old)
18.                                     (not
19.                                         (vl-catch-all-error-p
20.                                             (setq lay
21.                                                 (vl-catch-all-apply 'vla-item
22.                                                     (list (vla-get-layers doc) old)
23.                                                 )
24.                                             )
25.                                         )
26.                                     )
27.                                 )
28.                                 (vla-put-color lay oco)
29.                             )
30.                         )
31.                         lst t
32.                     )
33.                 )
34.             )
35.         )
36.     )
37.     (princ)
38. )

[MSTG007]

Wow Sweet! Thank you.

[MSTG007]

Well, I did get a chance to look at it. The following code is what I tried to put together into one lisp like they suggested above.

Code: [Select]

(defun c:test ( / lay lst nco new oco old )
    (while (not (or (= "" (setq new (getstring t "\nSpecify new layer name <skip>: "))) (snvalid lay)))
        (princ "\nInvalid layer name.")
    )
    (if (or (= "" new) (setq nco (acad_colordlg 7 nil)))
        (progn
            (while (not (or (= "" (setq old (getstring t "\nSpecify old layer name <skip>: "))) (snvalid lay)))
               (princ "\nInvalid layer name.")
           )
           (if (or (= "" old) (setq oco (acad_colordlg 7 nil)))
                (if (setq lst (LM:getfiles "Select drawings to process" "" "dwg;dwt;dws"))
                    (LM:odbx
                      '(lambda ( doc / lay )
                            (if (/= "" new)
                                (vla-put-color (vla-add (vla-get-layers doc) new) nco)
                            )
                           (if (and (/= "" old)
                                    (not
                                       (vl-catch-all-error-p
                                           (setq lay
                                               (vl-catch-all-apply 'vla-item
                                                   (list (vla-get-layers doc) old)
                                                )
                                            )
                                        )
                                   )
                                )
                                (vla-put-color lay oco)
                            )
                        )
                        lst t
                   )
                )
            )
        )
    )
    (princ)
)


;;------------------=={ Get Files Dialog }==------------------;;
;;                                                            ;;
;;  An analog of the 'getfiled' function for multiple files.  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg - Dialog box label; 'Select Files' if nil or "".      ;;
;;  def - Default directory; dwgprefix if nil or "".          ;;
;;  ext - File extension filter (e.g. "dwg;lsp"); "*" if nil  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of selected files, else nil                ;;
;;------------------------------------------------------------;;
;;  Version 1.3    -    25-07-2013                            ;;
;;------------------------------------------------------------;;

(defun LM:getfiles ( msg def ext / *error* dch dcl des dir dirdata lst rtn )

    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'int (type dch)) (< 0 dch))
            (unload_dialog dch)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )   
   
    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (progn
                (foreach x
                   '(
                        "lst : list_box"
                        "{"
                        "    width = 40.0;"
                        "    height = 20.0;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "    multiple_select = true;"
                        "}"
                        "but : button"
                        "{"
                        "    width = 20.0;"
                        "    height = 1.8;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "}"
                        "getfiles : dialog"
                        "{"
                        "    key = \"title\"; spacer;"
                        "    : row"
                        "    {"
                        "        alignment = centered;"
                        "        : edit_box { key = \"dir\"; label = \"Folder:\"; }"
                        "        : button"
                        "        {"
                        "            key = \"brw\";"
                        "            label = \"Browse\";"
                        "            fixed_width = true;"
                        "        }"
                        "    }"
                        "    spacer;"
                        "    : row"
                        "    {"
                        "        : column"
                        "        {"
                        "            : lst { key = \"box1\"; }"
                        "            : but { key = \"add\" ; label = \"Add Files\"; }"
                        "        }"
                        "        : column {"
                        "            : lst { key = \"box2\"; }"
                        "            : but { key = \"del\" ; label = \"Remove Files\"; }"
                        "        }"
                        "    }"
                        "    spacer; ok_cancel;"
                        "}"
                    )
                    (write-line x des)
                )
                (setq des (close des))
                (< 0 (setq dch (load_dialog dcl)))
            )
            (new_dialog "getfiles" dch)
        )
        (progn
            (setq ext (if ext (LM:getfiles:str->lst (strcase ext) ";") '("*")))
            (set_tile "title" (if (member msg '(nil "")) "Select Files" msg))
            (set_tile "dir"
                (setq dir
                    (LM:getfiles:fixdir
                        (if (or (member def '(nil "")) (not (vl-file-directory-p (LM:getfiles:fixdir def))))
                            (getvar 'dwgprefix)
                            def
                        )
                    )
                )
            )
            (setq lst (LM:getfiles:updatefilelist dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)

            (action_tile "brw"
                (vl-prin1-to-string
                   '(if (setq tmp (LM:getfiles:browseforfolder "" nil 512))
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )                             
                    )
                )
            )

            (action_tile "dir"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:fixdir $value))) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )
                    )
                )
            )

            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm tmp )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (cond
                                        (   (equal '("..") itm)
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:updir dir))) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (and
                                                (not (vl-filename-extension (car itm)))
                                                (vl-file-directory-p (setq tmp (LM:getfiles:checkredirect (strcat dir "\\" (car itm)))))
                                            )
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                                  lst (LM:getfiles:updatefilelist dir ext rtn)
                                            )
                                        )
                                    )
                                    (if (vl-some 'vl-filename-extension itm)
                                        (mode_tile "add" 0)
                                    )
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "box2"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n rtn)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (setq rtn (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
                                          lst (LM:getfiles:updatefilelist dir ext rtn)
                                    )
                                    (mode_tile "del" 0)
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "add"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm
                                    (vl-remove-if-not 'vl-filename-extension
                                        (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" (get_tile "box1") ")")))
                                    )
                                )
                                (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                      rtn (LM:getfiles:updateselected dir rtn)
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )

            (action_tile "del"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (read (strcat "(" (get_tile "box2") ")")))
                                (setq rtn (LM:getfiles:updateselected dir (LM:getfiles:removeitems itm rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq rtn nil)
            )
        )
    )
    (*error* nil)
    rtn
)

(defun LM:getfiles:listbox ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)

(defun LM:getfiles:listfiles ( dir ext lst )
    (vl-remove-if '(lambda ( x ) (member (strcat dir "\\" x) lst))
        (cond
            (   (cdr (assoc dir dirdata)))
            (   (cdar
                    (setq dirdata
                        (cons
                            (cons dir
                                (append
                                    (LM:getfiles:sortlist (vl-remove "." (vl-directory-files dir nil -1)))
                                    (LM:getfiles:sort
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-remove-if-not
                                                (function
                                                    (lambda ( x / e )
                                                        (and
                                                            (setq e (vl-filename-extension x))
                                                            (setq e (strcase (substr e 2)))
                                                            (vl-some '(lambda ( w ) (wcmatch e w)) ext)
                                                        )
                                                    )
                                                )
                                                (vl-directory-files dir nil 1)
                                            )
                                        )
                                    )
                                )
                            )
                            dirdata
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:checkredirect ( dir / itm pos )
    (cond
        (   (vl-directory-files dir) dir)
        (   (and
                (=  (strcase (getenv "UserProfile"))
                    (strcase (substr dir 1 (setq pos (vl-string-position 92 dir nil t))))
                )
                (setq itm
                    (cdr
                        (assoc (substr (strcase dir t) (+ pos 2))
                           '(
                                ("my documents" . "Documents")
                                ("my pictures"  . "Pictures")
                                ("my videos"    . "Videos")
                                ("my music"     . "Music")
                            )
                        )
                    )
                )
                (vl-file-directory-p (setq itm (strcat (substr dir 1 pos) "\\" itm)))
            )
            itm
        )
        (   dir   )
    )
)

(defun LM:getfiles:sort ( lst )
    (apply 'append
        (mapcar 'LM:getfiles:sortlist
            (vl-sort
                (LM:getfiles:groupbyfunction lst
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension a))
                            (setq y (vl-filename-extension b))
                            (= (strcase x) (strcase y))
                        )
                    )
                )
                (function
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension (car a)))
                            (setq y (vl-filename-extension (car b)))
                            (< (strcase x) (strcase y))
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:sortlist ( lst )
    (mapcar (function (lambda ( n ) (nth n lst)))
        (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
            (function
                (lambda ( a b / x y )
                    (while
                        (and
                            (setq x (car a))
                            (setq y (car b))
                            (= x y)
                        )
                        (setq a (cdr a)
                              b (cdr b)
                        )
                    )
                    (cond
                        (   (null x) b)
                        (   (null y) nil)
                        (   (and (numberp x) (numberp y)) (< x y))
                        (   (= "." x))
                        (   (numberp x))
                        (   (numberp y) nil)
                        (   (< x y))
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:getfiles:groupbyfunction (reverse tmp2) fun))
        )
    )
)

(defun LM:getfiles:splitstring ( str )
    (
        (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (apply 'append
                            (mapcar
                                (function
                                    (lambda ( a b c )
                                        (cond
                                            (   (= 92 b)
                                                (list 32 34 92 b 34 32)
                                            )
                                            (   (or (< 47 b 58)
                                                    (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                                    (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                                )
                                                (list b)
                                            )
                                            (   (list 32 34 b 34 32))
                                        )
                                    )
                                )
                                (cons nil l) l (append (cdr l) '(( )))
                            )
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list (strcase str))
    )
)

(defun LM:getfiles:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (LM:getfiles:fixdir (vlax-get-property slf 'path))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)



The above is just a snippet of the file that I have attached.

It asks me a layer and I enter REVISION1 and then errors out.

[Lee Mac]

Sorry, I forgot to rename a few variables, try the attached.

[MSTG007]

dude... fully working over here! Its gonna be scary what things I can think about using this for... way cool.

[Lee Mac]

dude... fully working over here! Its gonna be scary what things I can think about using this for... way cool.

Excellent to hear - I hope it saves you some time 

[HasanCAD]

I belive that, this routine will be great if can read from Excel file (which has old and new layers) and names as "LAYTRANS-update"

[MSTG007]

Is it possible with this routine to do a batch xref. Lets say I have a project. All the files dwgs have the job number in the name. I then copy it to a new jopb number and rename those files. Can this possible help replace the paths with dwgs I have renamed rather than opening each drawing and browsing for each xref in all the drawings? :ugly:

[Lee Mac]

I belive that, this routine will be great if can read from Excel file (which has old and new layers) and names as "LAYTRANS-update"

Certainly possible - but unfortunately more time & work than I can justify donating to the forum...

Is it possible with this routine to do a batch xref. Lets say I have a project. All the files dwgs have the job number in the name. I then copy it to a new jopb number and rename those files. Can this possible help replace the paths with dwgs I have renamed rather than opening each drawing and browsing for each xref in all the drawings? :ugly:

Yes, this should be possible -
You can simply pass a function to my LM:odbx function to modify the ActiveX Path property for each of your xrefs.

Here is a very rough example:

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ( / lst )
2.     (if (setq lst (LM:getfiles "Select drawings to process" "" "dwg;dwt;dws"))
3.         (LM:odbx
4.            '(lambda ( doc / str )
5.                 (vlax-for blk (vla-get-blocks doc)
6.                     (if (and (= :vlax-true (vla-get-isxref blk))
7.                              (wcmatch (setq str (vla-get-path blk)) "*oldjobnumber*")
8.                         )
9.                         (vla-put-path blk (vl-string-subst "newjobnumber" "oldjobnumber" str))
10.                     )
11.                 )
12.             )
13.             lst t
14.         )
15.     )
16.     (princ)
17. )