Share Your Favorite usefull LISP files

[Anonymous]

Share Your Favorite Lisp files and Customization to helpful others.

thanks,

[Jonathan3891]

RevCloud - A revision cloud utility that contains 3 commands [Polyline/Freehand/Triangle]. Using the first two commands, after completion your prompted to enter the revision number which will then insert a revision triangle with the specified revision number. The third option is just to insert the rev triangle.

Zdif - a handy elevation calculator between two points.

[Anonymous]

@Sea-Haven 

Is there any link to the LISPs listed in your document? Thanks!

[john.uhden]

I have one I use quite a bit. When you pick a nested object you get a
dialog to choose which members of the ancestry tree that you want to
freeze. But it's not built for individual use. It's still part of the VLX
package I used to try to sell, like 20 years ago.

[Jonathan3891]

Modz - Allows you to modify the elevation of simple objects. You can manually input the elevation or use the "GET" button to match the elevation of an object.

[Sea-Haven]

No link at this stage whilst I have a domain the interest is not high enough to have a website email me on info@alanh.com.au about what your intersted in.

[diagodose2009]

You program TW.Lsp you see new-version, you seeLisp but encrypted.

Main Hint is "You do not use multpile commands C:SNap, C:Tw , C:Q2, C:TWL

You use on command (C:TW) with 

dfn_getx_readkey("[AEWT50H439]","(W.twist) (P.180-pi) (H.90+)(5.45+)(4.1pi/4)(3.3pi/4)(9.90=)(0.0)(X.Exit) (A.About)");

[vaughan.giles7AGEV]

A couple of my daily favourites:

XFIX - Puts all XREFs in a drawing onto their own named layers and locks them.

LCC - Lets you change a colour of a layer by selecting an object on that layer. Side-note, this command will not work if you have an RGB true colour override.

[ronjonp]

---

@vaughan.giles7AGEV wrote:

A couple of my daily favourites:

XFIX - Puts all XREFs in a drawing onto their own named layers and locks them.

LCC - Lets you change a colour of a layer by selecting an object on that layer. Side-note, this command will not work if you have an RGB true colour override.

---

@vaughan.giles7AGEV  This is my version to set layer colors by picking objects .. it does RGB and color books too 🙂

(defun c:clc (/ c d e f l n)
  ;; RJP » 2018-08-17
  ;; Set layer color by pick
  (or (getenv "clc") (setenv "clc" "(62 . 1)"))
  (cond	((setq c (acad_truecolordlg (read (getenv "clc"))))
	 (setenv "clc" (vl-prin1-to-string (last c)))
	 (setq d (vla-get-activedocument (vlax-get-acad-object)))
	 (while	(setq e (nentsel "\nSelect entity to change layer color: "))
	   ;; RJP » 2024-08-15
	   ;; Added a flag to stop setting layer colors once one is changed
	   (setq f nil)
	   (foreach x (append (list (car e)) (cadddr e))
	     (and (setq n (cdr (assoc 8 (entget x))))
		  (setq l (tblobjname "layer" n))
		  (null f)
		  (setq f (not (wcmatch (strcase n) "0,DEFPOINTS")))
		  (entmod (append (entget l) c))
		  (vla-regen d acactiveviewport)
	     )
	   )
	 )
	)
  )
  (princ)
)

[j_avila_tgt]

What do they do exactly?  

[ryanYF2FK]

(Duplicate)

[ryanYF2FK]

Here's a base file I've made to help test lisps as you create them. It reloads itself with command "RLL", so that you don't have to go through the AppLoad menu every time you make a small change. Just paste in the lisp you're currently testing.

You'll have to insert this file's file path into its code, if that makes sense. You also have to double every backslash within the path b/c of the programming language itself. There are notes and an example in the file. The example is even formatted like a typical Downloads folder path to make it really similar to a path on your own PC.

[Sea-Haven]

A couple of cooments reload lisp during coding.

Notepad ++ supports running code from within Notepad++

I copy and paste complete defuns or full code to command line no blank lines in code tidy up once working and post here.

[DGCSCAD]

I create my LISP functions in Notepad and drag/drop the xxx.lsp file onto a dwg after each change when I'm testing. No appload needed.

[Kent1Cooper]

---

@Sea-Haven wrote:

.... I copy and paste complete defuns or full code to command line ....

---

I often do it that way, which does not even require that the code be saved to a named file yet, as APPLOAD and/or drag-&-drop of the file would require.  But for a file that I have named [and saved to a folder where AutoCAD knows to look], I use these commands:

(defun C:TL () ; Test Lisp routine under development
  (while
    (=
      (load
        (cond (testlisp) ((setq testlisp (getstring "\nLisp Routine: "))))
        "nogo" ; onfailure
      ); load
      "nogo"
    ); =
    (setq testlisp nil); wipe out and try again
    (prompt "\nNo such Routine file-name --")
  ); while
  (prin1)
)

(defun C:TLnew ()
  (setq testlisp nil)
  (C:TL)
)

Once I have established the file I'm developing with the first TL command, after I've worked in it [and saved it], back in the drawing I just type TL and it's reloaded -- no APPLOAD, no drag-&-drop, no copy/paste involving the clipboard.  If I finish with one and want to work on another, TLNEW is there to not reload the known file but ask for a new file name.

[One adjustment I may decide to make, whether inherently or as an option, would be to have it not ask for a file name as a text string, but let me navigate to get it.]

[LDShaw]

I'll post 2
I wrote this one to backup my working files for my projects. 
The second one opens the folder I am working in. 
Lisp 1.

;;; ==============================================================================
;;; Lisp Name: archive_and_save.lsp
;;; Author: Lonnie
;;; Date Created: 2024-06-06
;;; https://www.theswamp.org/index.php?topic=59596.msg621100#msg621100
;;; Last Edited: [Insert Last Edit Date]
;;;
;;; DESCRIPTION:
;;; A routine to archive and save files related to the current AutoCAD drawing.
;;;
;;; Usage:
;;; 1. Load the Lisp routine.
;;; 2. Run the command "DCARCH" in AutoCAD.
;;;
;;; Parameters:
;;; dwgDir currentDate year month day formattedDate archiveDir foldername dwgFiles txtFiles csvFiles rvtFiles allFiles pngFiles jpgFiles xlsxFiles
;;;
;;; Returns:
;;; None
;;;
;;; Notes:
;;; - This routine archives and saves files (DWG, TXT, CSV, RVT, PNG, JPG, XLSX) 
;;;   related to the current AutoCAD drawing in a dated subfolder within an 
;;;   "archive" directory.
;;;
;;; ---------------------------- Main program --------------------------------;

(defun C:dcarch (/ dwgDir currentDate year month day formattedDate archiveRootDir archiveDir foldername dwgFiles txtFiles csvFiles rvtFiles allFiles pngFiles jpgFiles xlsxFiles userResponse)

  ;; Get the directory of the current drawing
  (setq dwgDir (getvar "dwgprefix"))
  
  ;; Get and format the current date
  (setq currentDate (rtos (getvar "cdate") 2 5))
  (setq year (substr currentDate 1 4))
  (setq month (substr currentDate 5 2))
  (setq day (substr currentDate 7 2))
  (setq formattedDate (strcat year "-" month "-" day))
  
  ;; Define the archive root directory and the dated subdirectory
  (setq archiveRootDir (strcat dwgDir "Archive\\"))
  (setq archiveDir (strcat archiveRootDir formattedDate))
  (setq foldername (strcat archiveDir "\\"))


  ;; Check if the archive root directory exists
  (if (not (vl-file-directory-p archiveRootDir))
    (progn
      ;; Prompt the user to create the archive directory
      (setq userResponse (getstring (strcat "The archive directory does not exist. Do you want to create it? (Y/N): ")))
      ;; If the user wants to create it, do so
      (if (or (equal (strcase userResponse) "Y") (equal (strcase userResponse) "YES"))
        (vl-mkdir archiveRootDir)
        (progn
          (prompt "\nThe archive directory does not exist and was not created. Exiting command.")
          (exit)
        )
      )
    )
  )

  ;; Create the dated subdirectory
  (vl-mkdir archiveDir)

  ;; Function to list files in a directory matching a specific pattern (case-insensitive)
  (defun list-files (dir pattern)
    (vl-remove-if 'null
      (mapcar '(lambda (file)
                 (if (wcmatch (strcase file) (strcase pattern))
                   (strcat dir file)
                 )
               )
               (vl-directory-files dir)
      )
    )
  )

  ;; Function to copy a file from source to destination
  (defun copy-file (src dst)
    (vl-file-copy src dst)
  )

  ;; Get lists of files with specified extensions
  (setq dwgFiles (list-files dwgDir "*.DWG"))
  (setq txtFiles (list-files dwgDir "*.TXT"))
  (setq csvFiles (list-files dwgDir "*.CSV"))
  (setq rvtFiles (list-files dwgDir "*.RVT"))
  (setq rfaFiles (list-files dwgDir "*.RFA"))
  (setq pngFiles (list-files dwgDir "*.PNG"))
  (setq jpgFiles (list-files dwgDir "*.JPG"))
  (setq xlsxFiles (list-files dwgDir "*.XLSX"))

  ;; Combine all file lists
  (setq allFiles (append dwgFiles txtFiles csvFiles rvtFiles rfaFiles jpgFiles pngFiles xlsxFiles))

  ;; Copy each file to the archive directory
  (foreach file allFiles
    (copy-file file (strcat foldername (vl-filename-base file) (vl-filename-extension file)))
  )
)

It
1. Looks for an archive folder.
If it's not there it creates one.
2. Creates a folder with todays date in the archive folder. 
3. Looks for 
dwg txt csv rct rfa pnk jpg and xlsx files and copies them into that dated folder. 

This way I can do stupid without fear.

Lisp 2.

;;; ==============================================================================
;;; Lisp Name: PWD.LSP
;;; Author: Lonnie
;;; Date Created: [10-04-23]
;;; Last Edited: [Insert Last Edit Date]
;;;
;;; DESCRIPTION:
;;; A routine to open the folder containing the current AutoCAD drawing file.
;;;
;;; Usage:
;;; 1. Load the Lisp routine.
;;; 2. Run the command "PWD" in AutoCAD.
;;;
;;; Parameters:
;;; None
;;;
;;; Returns:
;;; None
;;;
;;; Notes:
;;; - This routine opens the folder containing the current AutoCAD drawing file.
;;;
;;; ---------------------------- Main program --------------------------------;


(defun C:PWD (/ ShellObject)
(vl-load-com)
	(setq ShellObject (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))
	(vlax-invoke-method ShellObject 'Explore (getvar "dwgprefix"))
	(vlax-release-object ShellObject)
)

[DGCSCAD]

@Kent1Cooper 

Thats why you're a 12 and I'm 7.9375 rounded up. 🙂

[Sea-Haven]

Lost count of how many times I have overwritten Test.lsp. Working in Notepad++ just save it, then from explorer drag and drop. Dual screens helps even though I have a laptop. When happy save with real name.

[Kent1Cooper]

---

@Sea-Haven wrote:

Lost count of how many times I have overwritten Test.lsp. ....

---

My preferred working file name for overwriting like that, when I haven't gotten to naming a file yet, is junk.lsp, so I know it's never something I need to keep once I've saved what I was working on in it to a "real" name.  I even have a dedicated little command defined for reloading that one quickly:

(defun C:JU () ; load JUnk.lsp for testing routines
  (load "junk.lsp")
)

[ronjonp]

@LDShaw Here's my code to open the current directory. The main difference is using 'open vs 'explore will prevent multiple windows with the same path from opening. 🙂

;; Open folder current directory
(defun c:cd (/ _opendirectory)
  (defun _opendirectory	(path / sa)
    (cond ((and	(eq 'str (type path))
		(findfile (vl-string-right-trim "\\" path))
		(setq sa (vlax-create-object "Shell.Application"))
	   )
	   ;; ;; RJP   2024-02-14
	   ;; Using 'open vs 'explore will not open multiple windows with the same path
	   ;; https://www.theswamp.org/index.php?topic=59280.msg619291#msg619291
	   (vlax-invoke sa 'open path)
	   (vlax-release-object sa)
	  )
    )
    (princ)
  )
  (_opendirectory (getvar 'dwgprefix))
)

[john.uhden]

@Kent1Cooper ,

I am flattered that you named your little command after me.  😁