Topic: Change hard location dwg to a User Browse for dwg

[MSTG007]

I stumbled upon this routine and was wondering how could i change it from (copy-blk  "T:\\ACLAND\\2016\\Next_Gen\\APENDIX.dwg" "NORTH") to a (copy-blk  "USER Browses for DWG Dialog Box" "NORTH") ?


https://www.theswamp.org/index.php?topic=53001.0

Code: [Select]

;; (copy-blk  "T:\\ACLAND\\2016\\Next_Gen\\APENDIX.dwg" "NORTH");;;;;;
;; return T if successful, nil otherwise;;;;;;;;;;

(vl-load-com)
(defun copy-blk (dwg blk / blkdbx catch odbx)
  (if (findfile dwg)
    (progn
      (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq odbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq odbx (vlax-create-object
                     (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))
                   )
        )
      )
      (vla-open odbx dwg)
      (if (not
            (setq
              catch (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function (lambda () (setq blkdbx (vla-item (vla-get-blocks odbx) blk))))
                      )
                    )
            )
          )
        (vla-copyobjects
          odbx
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbObject '(0 . 0))
            (list blkdbx)
          )
          (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        )
      )
      (vlax-release-object odbx)
      (if (and (null catch)
               (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                         blk
               )
          )
        T
        nil
      )
    )
    nil
  )
)


Hope that makes sense! thx

[ronjonp]

(getfiled "Select a DWG File" (getvar 'dwgprefix) "DWG" 0) ?

[mhupp]

untested  (copy-blk "north")
starts in the folder the current drawing is in. if you want to start in a certain folder change the path to that. you will still have to select the block tho.

Code: [Select]

(defun copy-blk (blk / dwg blkdbx catch odbx)
  (vl-load-com)
  (setq path (getvar 'DWGPREFIX))
  (if (setq dwg (getfiled "Select Block:" path "" 33))
    (progn
      (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq odbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq odbx (vlax-create-object
                     (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))
                   )
        )
      )
      (vla-open odbx dwg)
      (if (not
            (setq
              catch (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function (lambda () (setq blkdbx (vla-item (vla-get-blocks odbx) blk))))
                      )
                    )
            )
          )
        (vla-copyobjects
          odbx
          (vlax-safearray-fill
            (vlax-make-safearray vlax-vbObject '(0 . 0))
            (list blkdbx)
          )
          (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
        )
      )
      (vlax-release-object odbx)
      (if (and (null catch)
               (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                         blk
               )
          )
        T
        nil
      )
    )
    nil
  )
)

[MSTG007]

Nailed it! Works.

Code: [Select]

(defun copy-blk (dwg blk / blkdbx catch odbx)
  (if (findfile dwg)
to this...

Code: [Select]

(defun copy-blk (blk / dwg blkdbx catch odbx)
  (vl-load-com)
  (setq path (getvar 'DWGPREFIX))
  (if (setq dwg (getfiled "Select Block:" path "" 33))
Thank you for your help. I think i can apply this to some others that are hard coded and use this method!

[ronjonp]

Nailed it! Works.

Code: [Select]

(defun copy-blk (dwg blk / blkdbx catch odbx)
  (if (findfile dwg)
to this...

Code: [Select]

(defun copy-blk (blk / dwg blkdbx catch odbx)
  (vl-load-com)
  (setq path (getvar 'DWGPREFIX))
  (if (setq dwg (getfiled "Select Block:" path "" 33))
Thank you for your help. I think i can apply this to some others that are hard coded and use this method!

Rather than embedding it in the sub-function, consider:

Code - Auto/Visual Lisp: [Select]

1. (if (setq dwg (getfiled "Select a DWG File" (getvar 'dwgprefix) "DWG" 33))
2.   (copy-blk dwg (vl-filename-base dwg))
3. )

[MSTG007]

Interesting... I can plug and play that alittle more easier. Thank you for the tip!

[JohnK]

I would reccomend slightly more error checking--then just a raw `getfiled` call. -i.e. you can search the support path(s) to save time and do a little error checking if the user fails to actually pick a drawing.

Code - Auto/Visual Lisp: [Select]

1. (defun include (FileNeeded / FileNeeded FileLoc)
2.   (cond
3.     ((and (findfile FileNeeded))
4.      FileNeeded)
5.     ((not (findfile FileNeeded))
6.      (cond
7.        ((setq FileLoc
8.               (getfiled
9.                 (strcat
10.                   FileNeeded " File not on path, locate manually")
11.                 FileNeeded
12.                 (vl-string-left-trim "." (vl-filename-extension FileNeeded))
13.                 2
14.                 )
15.               )
16.         FileLoc)
17.        (T (alert "Sorry, The file has not been located.")))
18.      )
19.     )
20.  )

Usage:
(setq drawingFile (include "<SOME DRAWING FILE YOU WANT>"))
(if drawingFile (copy-blk drawingFile))

[tombu]

FYI for Map 3D & verticals the macro

Code: [Select]

^C^C^P(progn(startapp "explorer" (strcat "/n,/e," (vl-string-subst (strcat "Map" (chr 92) "Sample" (chr 92) "Symbols") "express" (vl-filename-directory (findfile "acetauto.lsp")))))(princ))
;should open the folder Map - North Arrows.dwg is saved in.
I found these links helpful https://forums.autodesk.com/t5/civil-3d-customization/civil-3d-2015-mapinsertple-command/m-p/9970125#M19256
https://help.autodesk.com/view/MAP/2022/ENU/?guid=GUID-83B4FB80-E739-4EFC-B633-4A6042C75998
https://www.theswamp.org/index.php?topic=48049.0;all
and put what I figured out with macros for the North Arrows I use at http://beauford.altervista.org/Dynamic_Blocks.html