Add multiple search folder on Block redefine Lisp

[francine.zimmermannSRSWJ]

I have a lisp written by Lee Mac.

Is it possible to add more as one search folder?

Actually in the lisp :

(setq dir "C:\\000_Block\\profile")

Desired folder :

"C:\\000_Block\\Block\\"
"C:\\000_Block\\Profile\\"

Thank you for your help

[ec-cad]

Untested, but something like this.

;; Redefine All Blocks  -  Lee Mac
(defun c:redef-tender ( / bln dir1 dir2 doc dwg lst obj org spc )

    (setq dir1 "C:\\000_Block\\Profile"); First Folder
    (setq dir2 "C:\\000_Block\\Block"); Second Folder
 

    (if dir1
        (setq dir1 (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir1)) "\\"))
        (setq dir1 "")
    )
    (if dir2
        (setq dir2 (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir2)) "\\"))
        (setq dir2 "")
    )
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   (setq doc (vla-get-activedocument (vlax-get-acad-object))
                  spc (vla-get-modelspace doc)
                  org (vlax-3D-point 0 0)
        )
            (terpri)
            (vlax-for blk (vla-get-blocks doc)

                (if
                    (and
                        (= :vlax-false (vla-get-isxref blk))
                        (= :vlax-false (vla-get-islayout blk))
                        (wcmatch (strcase (setq bln (vla-get-name blk))) "08*,KG*")
                    ); and
;; Check in First Folder
                    (if (setq dwg (findfile (strcat dir1 bln ".dwg")))
                        (progn
                            (princ (strcat "Redefining block: " dwg "\n"))
                            (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0))
                            (if (= :vlax-true (vla-get-hasattributes obj))
                                (setq lst (vl-list* "," bln lst))
                            ); if
                            (vla-delete obj)
                        ); progn
                       ;; (princ (strcat "Unable to locate block: " dir1 bln ".dwg\n"))
                    ); if
;; Check in Second Folder
                    (if (setq dwg (findfile (strcat dir2 bln ".dwg")))
                        (progn
                            (princ (strcat "Redefining block: " dwg "\n"))
                            (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0))
                            (if (= :vlax-true (vla-get-hasattributes obj))
                                (setq lst (vl-list* "," bln lst))
                            ); if
                            (vla-delete obj)
                        ); progn
                       ;; (princ (strcat "Unable to locate block: " dir2 bln ".dwg\n"))
                    ); if
;;
                ); if
;; loop
            ); vlax-for
            (textscr)
            (vla-regen doc acallviewports)
        )
    )
    (princ)
)
(vl-load-com) (princ)

ECCAD

[paullimapa · Accepted solution]

try this:

;; Redefine All Blocks  -  Lee Mac
;; add mulitple paths
;; OP:
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/add-multiple-search-folder-on-block-redefine-lisp/m-p/13053138#M472183
(defun c:redef-tender ( / bln dir dirlst doc dwg lst obj org spc )

; include all paths to search for block
  (setq dirlst 
    (list
     "C:\\000_Block\\Block"
     "C:\\000_Block\\Profile"
    )
  )
  (if(zerop(length dirlst))(setq dirlst (list ""))) 
    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
            (princ "\nCurrent layer locked.")
        )
        (   (setq doc (vla-get-activedocument (vlax-get-acad-object))
                  spc (vla-get-modelspace doc)
                  org (vlax-3D-point 0 0)
            )
            (terpri)
; cycle through each path
            (foreach itm dirlst
             (setq dir itm) 
             (if (not(zerop(strlen dir)))
              (setq dir (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)) "\\"))
              (setq dir "")
             )

             (vlax-for blk (vla-get-blocks doc)
                (if
                    (and
                        (= :vlax-false (vla-get-isxref blk))
                        (= :vlax-false (vla-get-islayout blk))
                         (wcmatch (strcase (setq bln (vla-get-name blk))) "08*,KG*")
                    )
                    (if (setq dwg (findfile (strcat dir bln ".dwg")))
                        (progn
                            (princ (strcat "Redefining block: " dwg "\n"))
                            (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0))
                            (if (= :vlax-true (vla-get-hasattributes obj))
                                (setq lst (vl-list* "," bln lst))
                            )
                            (vla-delete obj)
                        )
                        (princ (strcat "Unable to locate block: " dir bln ".dwg\n"))
                    )
                )
             )
            ) ; foreach

            (textscr)
            (vla-regen doc acallviewports)
        )
    )
    (princ)
)
(vl-load-com) (princ)