Jump to content

Recommended Posts

Posted

It seems acet-ui-pickdir does not work in AutoCAD LT 2024, are there any alternatives that might work?

 

I am still not sure what the exact limits are for LISP in LT, is there a link to some documentation? 

Posted (edited)

Says its a valid function.

 

 Might need to follow this format to work properly.

(acet-ui-pickdir [message [startDir [caption]]])

 

-Edit

Never Mind

https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-16E9081D-1447-4D37-8636-E7D39F3127EA

 

Quote

Supported Platforms: AutoCAD for Windows only; not available in AutoCAD LT for Windows, or on Mac OS and WebSupported Platforms: AutoCAD for Windows only; not available in AutoCAD LT for Windows, or on Mac OS and Web


 

Edited by mhupp
  • Like 1
Posted (edited)

Using getfiled maybe. 

 

(setq filename (getfiled "Select the File " "" "dwg" 16))

 

You can remove dwg name from filename so get path to that directory.

 

There is a post some where about what does not work, I think it was over at forums autodesk.

getapplication think Excel lisp linking

No load MNL

As mentioned Acet functions

 

 This got me to the LT 2024 help page and developer help. https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-86C522B8-9D44-43F5-B1E7-FC4BECAEBDCE

 

Found this comment by Lee-mac

Unfortunately many of my programs will not be compatible with AutoCAD LT, as the LISP API in LT does not support interfacing with ActiveX objects outside of the AutoCAD Object Model.

 

Edited by BIGAL
  • Like 1
Posted

I see if I can figure out something, it's not a top priority, would just be convenient for the Engineers with LT to do some of their own AutoCAD stuff.

 

I'll just have to do it on FULL AutoCAD for them until I figure something out.

 

Thanks for the links and information!

Posted
20 hours ago, mhupp said:

Says its a valid function.

 

 Might need to follow this format to work properly.

(acet-ui-pickdir [message [startDir [caption]]])

 

-Edit

Never Mind

https://help.autodesk.com/view/ACDLT/2024/ENU/?guid=GUID-16E9081D-1447-4D37-8636-E7D39F3127EA

 


 

I found that in AutoCAD 2024 Help file as well, just scratched my head, why any of the stuff that didn't work was in the help file I have no clue.

Posted

I made this a long long time ago , before I new about Shell.Application etc. Not the prettiest by today's standards but it got the job done for me at that time.

getfolder.lsp GetFolder.DCL

  • Like 3
  • 2 years later...
Posted (edited)
On 12/7/2023 at 5:25 PM, rlx said:

I made this a long long time ago , before I new about Shell.Application etc. Not the prettiest by today's standards but it got the job done for me at that time.

getfolder.lsp 3.06 kB · 21 downloads GetFolder.DCL 337 B · 17 downloads

 

I was looking for something quick and simple yesterday - thanks. Now the not so quick part, I decided to make the DCL file as 'create on demand' style, and then tweak it a touch.... and then sent it through Al... a bit updated does what I want now. (Al was reasonably competent in it saved me about an hour copy-paste from my reference LISPs)

 

Edit:

Oh, for LT... forgetting the reason I was looking - shortcut links use VLAX code and I think the desktop part needs amending too - shortcuts are bypassed - won't work in LT - desktop I'll come back to

 

(defun c:gf ( / DriveList CurDrive SubfolderList CurSubfolder GetFolderOldErr GetFolderDcl CurPath PathHistoryList MyResult)

  (defun GetFolder_init ( / MyDrawingDrive )
    (setq GetFolderDcl (load_dialog "GetFolder"))
    (setq GetFolderOldErr *error*)
    (setq *error* GetFolderErr)

    (MakeDriveList)

    (setq CurPath (getvar "DWGPREFIX")) ;; Current drawing folder
    (setq DrawingDrive (substr CurPath 1 2)) ;; Drive
    (setq CurDrive (vl-position DrawingDrive DriveList))
    (if (null CurDrive) (setq CurDrive 0)) ; End If
    (setq PathHistoryList (list CurPath))
    (MakeSubfolderList CurPath)
  ) ; End GetFolder_init

  (defun GetFolder_exit ( / )
    (setq CurPath CurPath)
  ) ; End GetFolder_exit

  (defun GetFolderErr ( s / )
    (GetFolder_exit)
    (if GetFolderOldErr
      (setq *error* GetFolderOldErr)
      (setq *error* '())
    ) ; End If
  ) ; End GetFolderErr

  (defun MakeDriveList ( / ascii-code drive )
    (setq DriveList '())
    (setq ascii-code 67) ;; ASCII code C = 67, Z = 90
    (while (<= ascii-code 90)
      (setq drive (strcat (chr ascii-code) ":") )
      (if (vl-file-directory-p drive)
        (setq DriveList (append DriveList (list drive)))
      ) ; End If
      (setq ascii-code (1+ ascii-code))
    ) ; End While
  ) ; End MakeDriveList

  (defun MakeSubfolderList ( dir / MyFolderList MyShortcutList )
    (if (and
        dir
        (= (type dir) 'STR)
        (vl-file-directory-p dir)
      ) ; End And
      (progn
        (setq MyFolderList (vl-directory-files dir nil -1) ) ;; Folders
        (if (= (getvar 'program) "LT")
          (setq SubfolderList (append (list "<-") MyFolderList  )) ;;LT vl-dirctoryfiles might not work
          (progn
            (setq MyShortcutList (vl-directory-files dir "*.lnk" 1) ) ;; Shortcuts
            (setq SubfolderList (append (list "<-") MyFolderList MyShortcutList ))
          ) ; end progn
        ) ; end if
      ) ; End Progn
      (setq SubfolderList (list "<-"))
    ) ; End If
    (setq SubfolderList (vl-remove "." SubfolderList) )
    (setq SubfolderList (vl-remove ".." SubfolderList))
    (if (wcmatch CurPath "@`:")
      (setq SubfolderList (vl-remove "<-" SubfolderList))
    ) ; End If
  ) ; End MakeSubfolderList

  (defun UpdateSubfolder ( $value / MyShortcut MyTarget MyShell )
    (setq CurSubfolder (nth (atoi $value) SubfolderList ))
    (cond
      ((equal CurSubfolder "<-") ;; Back to previous folder
        (if (= (length PathHistoryList) 1) ;; top level
          (progn
            (setq CurPath (car PathHistoryList))
          )
          (progn
            (setq CurPath (cadr PathHistoryList))
            (setq PathHistoryList (cdr PathHistoryList))
          ) ; end progn
        ) ; end if
      ) ; end cond
      ((wcmatch (strcase CurSubfolder) "*.LNK") ;; shortcut
        (if (= (getvar 'program) "LT") ;; LT doesn't do VLAX
          (progn
          )
          (progn
            (setq MyShell (vlax-create-object "WScript.Shell"))
            (setq MyShortcut (vlax-invoke-method MyShell 'CreateShortcut (strcat CurPath "\\" CurSubfolder)))
            (setq MyTarget (vlax-get-property MyShortcut 'TargetPath))
            (vlax-release-object MyShortcut)
            (vlax-release-object MyShell)
            (if (and ;; if lnk is a folder
                MyTarget
                (vl-file-directory-p MyTarget)
              ) ; End And
              (progn
                (setq PathHistoryList (append (list CurPath) PathHistoryList ))
                (setq CurPath MyTarget)  ;; Jump to shortcut target
              ) ; End Progn
;;              (alert "Shortcut does not point to a folder.")
            ) ; End If
          ) ; end progn lnk
        ) ; end if
      ) ; end cond
      (T ;; Normal folder
        (setq PathHistoryList (append (list CurPath) PathHistoryList ))
        (setq CurPath (strcat CurPath "\\" CurSubfolder) ) ;; Enter selected folder
      ) ; end cond T
    ) ; End Conds

    (MakeSubfolderList CurPath) ;; Rebuild folders and shortcuts for the new location

    ;; Replace existing DCL list contents
    (start_list "subfolder" 3)
    (mapcar 'add_list SubfolderList)
    (end_list)
    (set_tile "subfolder" "0")  ;; Select first item in refreshed list
    (set_tile "path" CurPath)  ;; Display new path
  ) ; End UpdateSubfolder

  (defun InitDialog ( / )
    (start_list "drive")
    (mapcar 'add_list DriveList)
    (end_list)
    (set_tile "drive" (itoa CurDrive)) ;; Select the drive containing the current drawing
    (start_list "subfolder")
    (mapcar 'add_list SubfolderList)
    (end_list)
    (set_tile "path" CurPath)  ;; Display the current drawing folder
  ) ; End InitDialog

  (defun GetFolder_dialog ( / fname GF drv MyDclFile dcl_id MyFile) ;; Create DCL file

;;Start DCL
    (setq GF (open (setq fname (vl-filename-mktemp "GetFolder" (getvar "TEMPPREFIX") ".dcl")) "w"))

;;Header
    (write-line "SelLays : dialog {" GF)
    (write-line "  key = \"Folder\";" GF)
    (write-line "  label = \"GetFolder (RLX-10/04)\";" GF)
    (write-line "  spacer;" GF)

;;Stuff
    (write-line "  :row {alignment = top;" GF)
    (write-line "    :column { width = 5; fixed_width = true; " GF)
    (write-line "      : popup_list {key = \"drive\";  label = \"Drive\"; edit_width = 7; }" GF)
    (write-line "    }" GF) ; end column
    (write-line "    :column { width = 38; fixed_width = true; " GF)
    (write-line "    }" GF) ; end column
    (write-line "  }" GF) ; end row

    (write-line "  :row {alignment = top;" GF)
    (write-line "    :column { width = 6; fixed_width = true; " GF)
    (write-line "    }" GF) ; end column
    (write-line "    :column { width = 12; fixed_width = true; " GF)
    (write-line "      :row {alignment = top;" GF)
    (write-line "        : button { key = \"uplevel\"; label = \"↑ Last level\"; width = 5; }" GF)
    (write-line "        : button { key = \"desktop\"; label = \"Desktop\"; width = 5; }" GF)
    (write-line "      }" GF) ; end row
    (write-line "    }" GF) ; end column
    (write-line "    :column { width = 32; fixed_width = true; " GF)
    (write-line "    }" GF) ; end column
    (write-line "  }" GF) ; end row

    (write-line "  :row {alignment = top;" GF)
    (write-line "    : list_box { key = \"subfolder\"; label = \"Subfolders\"; height = 12; width = 25; }" GF)
    (write-line "  }" GF) ; end row

    (write-line "  :row {alignment = top;" GF)
    (write-line "    : edit_box { key = \"path\"; label = \"Path\"; width = 25; }" GF)
    (write-line "  }" GF) ; end row
    (write-line "  ok_cancel;" GF)
    (write-line "}" GF)  ; end dialog
    (close GF)
    (setq dcl_id (load_dialog fname))

    (if (and
        dcl_id
        (new_dialog "SelLays" dcl_id)
      ) ; End And
      (progn
        (InitDialog)
        (action_tile "drive" " (UpdateDrive $value)" )
        (action_tile "desktop" "(UpdateDesktop)" )
        (action_tile "uplevel" "(UpdateUpLevel)" )
        (action_tile "subfolder" "(UpdateSubfolder $value)" )
        (action_tile "path" "(UpdatePath $value)" )
        (action_tile "accept" "(done_dialog 1)" )
        (action_tile "cancel" "(done_dialog 0)" )

        (setq drv (start_dialog))
        (cond 
          ((= drv 0) (setq CurPath nil) )
          ((= drv 1) (setq CurPath CurPath) )
        ) ; End Cond
      ) ; End Progn
    ) ; End If

    (if dcl_id (unload_dialog dcl_id) )
  ) ; End GetFolder_dialog

  (defun UpdateDrive ( $value / )
    (setq CurDrive (atoi $value) )
    (setq CurPath (nth CurDrive DriveList) )
    (MakeSubfolderList CurPath)
    (start_list "subfolder")
    (mapcar 'add_list SubfolderList)
    (end_list)
    (setq PathHistoryList (list CurPath) )
    (set_tile "path" CurPath)
  ) ; End UpdateDrive

  (defun UpdatePath ( dir / )
    (if (and
        dir
        (= (type dir) 'STR)
        (vl-file-directory-p dir)
      ) ; End And
      (setq CurPath dir)
      (alert "Invalid Path")
    ) ; End If
  ) ; End UpdatePath

  (defun UpdateUpLevel ( / MyParentPath )
    ;; Remove trailing slash if present
    (if (or
        (= (substr CurPath (strlen CurPath) 1) "\\")
        (= (substr CurPath (strlen CurPath) 1) "/")
      ) ; Endor
      (setq CurPath (substr CurPath 1 (1- (strlen CurPath))) )
    ) ; End If

    (setq MyParentPath (vl-filename-directory CurPath)) ;; parent folder
    (if MyParentPath
      (progn
        (setq CurPath MyParentPath)
        (MakeSubfolderList CurPath) ;; Refresh subfolder list
        (start_list "subfolder")
        (mapcar 'add_list SubfolderList)
        (end_list)
        (set_tile "path" CurPath) ;; Update displayed path
        (setq PathHistoryList (list CurPath)) ;; Reset history from new location
      ) ; End Progn
    ) ; End If
  ) ; End UpdateUpLevel

  (defun UpdateDesktop ( / MyShell MyDesktop ) ;;Double check for none VLAX for LT
    (if (= (getvar 'program) "LT")
      (progn
      )
      (progn
        (setq MyShell (vlax-create-object "WScript.Shell") )
        (setq MyDesktop (vlax-invoke-method (vlax-get-property MyShell 'SpecialFolders) 'Item "Desktop"))
        (vlax-release-object MyShell)
      )
    )

    (if
      (and
        MyDesktop
        (vl-file-directory-p MyDesktop)
      ) ; End And
      (progn
        (setq CurPath MyDesktop)
        (MakeSubfolderList CurPath)
        (start_list "subfolder")
        (mapcar 'add_list SubfolderList)
        (end_list)
        (set_tile "path" CurPath)
        (setq PathHistoryList (list CurPath))
      ) ; End Progn
      (alert "Desktop folder not found.")
    ) ; End If
  )

  (GetFolder_init)
  (GetFolder_dialog)
  (setq MyResult (GetFolder_exit))
  MyResult
)

 

 

Edited by Steven P
  • Like 1
Posted

I still try to think about LT usage when redoing an old LISP and creating new LISP, but it's not a real priority.

 

If those that use LT around here need something done with a LISP and we can't find one that runs on LT, I can see if it's adjustable to be made to work or I can just do it for them.

 

I originally asked this because an engineer with AutoCAD LT needed to convert a bunch of DGNs, I did end up converting a lot of folders with my LISP, but in the end the company that sent us the DGNs sent the exported from Autoplant .dwgs, etc., the DGNs we had converted okay, but IIRC some information was missing here and there for some of the files.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...