5 Great AutoLISP Scripts

I decided to post my favorite AutoLISP programs that I use extensively hoping that someone will find them useful. The two of them (as you can see in the code that I am providing) are written by me and their coding is very easy to understand and changed/tweaked (if someone has a bit of knowledge about AutoLISP). There are other two without their code provided by their authors but they are great (.vlx extension). Scripts can also be downloaded all together from here.

To learn how to load an AutoCAD script just look at this first

  • xytag.lsp this simple script written by me, prints the XY coordinates over a selected points. Useful if someone wants to have the coordinates quickly printed on the drawing. After loading the script just type the command xytag and the script will be activated.

[sourcecode language=”text”]

(defun c:xytag()

(while
(setq a (getpoint "\nEnter The Point"))
(setq X (rtos(car a)))
;metatropi real to string
;car a —>>to proto noumero apo ti lista tou a (X Y Z)
(setq Y (rtos(cadr a)))

(command "text" "br" a "0.2" "0" "X=")
(command "text" "bl" a "0.2" "0" X)
(command "text" "tr" a "0.2" "0" "Y=")
(command "text" "tl" a "0.2" "0" Y)
)

(prompt "\nWritten by Antonis Raftopoulos, raftopoulos.a@gmail.com, http://hedproject.wordpress.com")
)

[/sourcecode]

    • pntxt.lsp this one is an easy to understand program written also by me and all it does is to create a .txt file in the Documents folder with the coordinates of the points selected. First of all load the program and then type pntxt to activate it. After this the user will be prompted to type the file name (the name that the file will be saved). The program creates a file in the Documents folder with the name provided. Then the user just selects one by one (there is not a window selection mode yet) and when finished just press enter or right click.

[sourcecode language=”text”]

(defun c:pntxt(/ a filename filename2 TargetFile i i2 exitmsg)

;Creating the file
(setq filename (getstring T "\nType the name of the file:"))
(setq filename2 (strcat "c:\\Users\\Public\\Documents\\" filename ".txt"))
(setq TargetFile (open filename2 "w"))

(write-line "Point Number,X,Y,Z" TargetFile)

(setq i 0)
(while
(setq a (getpoint "\nTick the Point")) ;select points

(setq x (rtos(car a)))
(setq y (rtos(cadr a)))
(setq z (rtos(caddr a)))
(setq i (1+ i))
(setq i2 (itoa i))
(setq pnt (strcat i2"," x "," y ","z))

(write-line pnt TargetFile)

)

(close TargetFile)

(setq exitmsg (strcat "Your file is saved in c: as " filename ".txt" " Written by Antonis Raftopoulos,"
"raftopoulos.a@gmail.com, http://hedproject.wordpress.com"))

)

(princ exitmsg)

[/sourcecode]

    • 3dpolyfillet.lsp This one does exactly what it says: fillets 3D polylines!!! Very useful for 3D drafters. Just load it and type 3dpolyfillet.

[sourcecode language=”text”]

;;; 3dPolyFillet -Gilles Chanteau- 21/01/07 -Version 1.5-
;;; "Fillets" a 3D polyline (succession of segments)

(defun c:3dPolyFillet (/ 3dPolyFillet_err closest_vertices
MakeFillet AcDoc ModSp cnt
prec rad ent1 ent2
vxlst plst param obj
)
(vl-load-com)

;;;*************************************************************;;;

(defun 3dPolyFillet_err (msg)
(if (= msg "Fonction annulée")
(princ)
(princ (strcat "\nErreur: " msg))
)
(vla-EndUndoMark AcDoc)
(setq *error* m:err
m:err nil
)
(princ)
)

;;;*************************************************************;;;

(defun closest_vertices (obj pt / par)
(if (setq par (vlax-curve-getParamAtPoint obj pt))
(list (vlax-curve-getPointAtParam obj (fix par))
(vlax-curve-getPointAtParam obj (1+ (fix par)))
)
)
)

;;;*************************************************************;;;

(defun MakeFillet (obj par1 par2 / pts1 pts2 som p1 p2
ptlst norm pt0 pt1 pt2 pt3 pt4 cen ang
inc n vlst nb1 nb2
)
(if (and
(setq pts1 (closest_vertices obj par1))
(setq pts2 (closest_vertices obj par2))
)
(progn
(setq som (inters (car pts1) (cadr pts1) (car pts2) (cadr pts2) nil))
(if som
(if
(or (equal (car pts1) som 1e-9)
(equal (cadr pts1) som 1e-9)
(and
(< (vlax-curve-getParamAtPoint obj (car pts1))
(vlax-curve-getParamAtPoint obj (car pts2))
)
(equal (vec1 (car pts1) (cadr pts1))
(vec1 (car pts1) som)
1e-9
)
)
(and
(< (vlax-curve-getParamAtPoint obj (car pts2))
(vlax-curve-getParamAtPoint obj (car pts1))
)
(equal (vec1 (cadr pts1) (car pts1))
(vec1 (cadr pts1) som)
1e-9
)
)
)
(progn
(if (< (distance som (car pts1)) (distance som (cadr pts1))) (setq p1 (cadr pts1) p2 (car pts2) ) (setq p1 (car pts1) p2 (cadr pts2) ) ) (if (= rad 0) (setq ptlst (list som)) (progn (setq norm (norm_3pts som p2 p1) pt0 (trans som 0 norm) pt1 (trans p1 0 norm) pt2 (trans p2 0 norm) cen (inters (polar pt0 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt1 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt0 (+ (angle pt0 pt2) (/ pi 2)) rad) (polar pt2 (+ (angle pt0 pt2) (/ pi 2)) rad) nil ) pt3 (polar cen (- (angle pt1 pt0) (/ pi 2)) rad) pt4 (polar cen (+ (angle pt2 pt0) (/ pi 2)) rad) ang (- (angle cen pt4) (angle cen pt3)) ) (if (and (inters pt0 pt1 cen pt3 T) (inters pt0 pt2 cen pt4 T)) (progn (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) (setq inc (/ ang prec) n 0 ) (repeat (1+ prec) (setq ptlst (cons (polar cen (- (angle cen pt4) (* inc n)) rad) ptlst ) n (1+ n) ) ) (setq ptlst (mapcar ‘(lambda (p) (trans p norm 0)) ptlst)) ) ) ) ) (setq vlst (3d-coord->pt-lst (vlax-get obj ‘Coordinates)))
(if ptlst
(progn
(setq nb1 (vl-position p1 vlst)
nb2 (vl-position p2 vlst)
)
(if (= (vla-get-closed obj) :vlax-true)
(cond
((and (equal p1 (car vlst))
(equal p2 (cadr (reverse vlst)))
)
(setq
vlst
(append (sublst vlst 1 (1+ nb2)) (reverse ptlst))
)
)
((and (equal p1 (cadr (reverse vlst)))
(equal p2 (car vlst))
)
(setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst))
)
((and (equal p1 (cadr vlst))
(equal p2 (last vlst))
)
(setq
vlst
(append (reverse ptlst) (sublst vlst (1+ nb1) nil))
)
)
((and (equal p1 (last vlst))
(equal p2 (cadr vlst))
)
(setq vlst (append ptlst (sublst vlst (1+ nb2) nil))
)
)
(T
(if (< nb1 nb2)
(setq vlst (append (sublst vlst 1 (1+ nb1))
ptlst
(sublst vlst (1+ nb2) nil)
)
)
(setq vlst (append (sublst vlst 1 (1+ nb2))
(reverse ptlst)
(sublst vlst (1+ nb1) nil)
)
)
)
)
)
(if (equal (car vlst) (last vlst) 1e-9)
(cond
((and (equal p1 (cadr vlst))
(equal p2 (cadr (reverse vlst)))
)
(setq vlst (append (sublst vlst 2 nb2)
(reverse ptlst)
(list (cadr vlst))
)
)
)
((and (equal p1 (cadr (reverse vlst)))
(equal p2 (cadr vlst))
)
(setq vlst (append (sublst vlst 2 nb1)
ptlst
(list (cadr vlst))
)
)
)
)
(if (< nb1 nb2)
(setq vlst (append (sublst vlst 1 (1+ nb1))
ptlst
(sublst vlst (1+ nb2) nil)
)
)
(setq vlst (append (sublst vlst 1 (1+ nb2))
(reverse ptlst)
(sublst vlst (1+ nb1) nil)
)
)
)
)
)
(vlax-put obj ‘Coordinates (apply ‘append vlst))
)
(prompt "\nRadius is too large.")
)
)
(prompt "\nDivergent segments.")
)
(prompt "\nSegments are not converging.")
)
)
(prompt "\nRadius is too large.")
)
)

;;;*************************************************************;;;

(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
)
(setq m:err *error*
*error* 3dPolyFillet_err
)
(vla-StartUndoMark AcDoc)

;; Saisie des données
(if (not (vlax-ldata-get "3dFillet" "Prec"))
(vlax-ldata-put "3dFillet" "Prec" 20)
)
(if (not (vlax-ldata-get "3dFillet" "Rad"))
(vlax-ldata-put "3dFillet" "Rad" 10.0)
)
(prompt (strcat "\nCurrent settings.\tSegments: "
(itoa (vlax-ldata-get "3dFillet" "Prec"))
"\tRadius: "
(rtos (vlax-ldata-get "3dFillet" "Rad"))
)
)
(setq cnt 1)
(while (= 1 cnt)
(initget 1 "Segments Radius")
(setq ent1
(entsel
"\nSelect first segment ou [Segments/Radius]: "
)
)
(cond
((not ent1)
(prompt "\nNone selected object.")
)
((= ent1 "Segments")
(initget 6)
(if (setq prec
(getint
(strcat "\nSpecify le number of segments for arcs <" (itoa (vlax-ldata-get "3dFillet" "Prec")) ">: "
)
)
)
(vlax-ldata-put "3dFillet" "Prec" prec)
)
)
((= ent1 "Radius")
(initget 4)
(if (setq rad
(getdist
(strcat "\nSpecify the radius <" (rtos (vlax-ldata-get "3dFillet" "Rad")) ">: "
)
)
)
(vlax-ldata-put "3dFillet" "Rad" rad)
)
)
((and
(= (cdr (assoc 0 (entget (car ent1)))) "POLYLINE")
(= (logand 8 (cdr (assoc 70 (entget (car ent1))))) 8)
)
(setq cnt 0)
)
(T
(prompt "\nSelected object is not a 3D polyline.")
)
)
)
(setq prec (vlax-ldata-get "3dFillet" "Prec")
rad (vlax-ldata-get "3dFillet" "Rad")
)
(while (not ent2)
(initget 1 "All")
(setq ent2 (entsel "\nSelect second segment or [All]: "))
(if (not (or (= ent2 "All") (eq (car ent1) (car ent2))))
(progn
(prompt
"\nThe selected segment is not on same object"
)
(setq ent2 nil)
)
)
)
(setq obj (vlax-ename->vla-object (car ent1)))
(if (= ent2 "All")
(progn
(setq vxlst (3d-coord->pt-lst (vlax-get obj ‘Coordinates))
param 0.5
)
(repeat (if (= (vla-get-closed obj) :vlax-true) (length vxlst) (1- (length vxlst)))
(setq plst (append plst (list (vlax-curve-getPointAtParam obj param)))
param (1+ param)
)
)
(if (or (= (vla-get-closed obj) :vlax-true)
(equal (car vxlst) (last vxlst) 1e-9)
)
(setq plst (cons (last plst) plst))
)
(setq cnt 0)
(repeat (1- (length plst))
(MakeFillet obj (nth cnt plst) (nth (setq cnt (1+ cnt)) plst))
)
)
(MakeFillet obj
(trans (osnap (cadr ent1) "_nea") 1 0)
(trans (osnap (cadr ent2) "_nea") 1 0)
)
)
(vla-EndUndoMark AcDoc)
(setq *error* m:err
m:err nil
)
(princ)
)

;;;*************************************************************;;;
;;;*********************** SOUS ROUTINES ***********************;;;

;;; NORM_3PTS returns the normal vector of a 3 points defined plane

(defun norm_3pts (org xdir ydir / norm)
(foreach v ‘(xdir ydir)
(set v (mapcar ‘- (eval v) org))
)
(if (inters org xdir org ydir)
(mapcar ‘(lambda (x) (/ x (distance ‘(0 0 0) norm)))
(setq norm (list (- (* (cadr xdir) (caddr ydir))
(* (caddr xdir) (cadr ydir))
)
(- (* (caddr xdir) (car ydir))
(* (car xdir) (caddr ydir))
)
(- (* (car xdir) (cadr ydir))
(* (cadr xdir) (car ydir))
)
)
)
)
)
)

;;;*************************************************************;;;

;;; 3d-coord->pt-lst Convert a 3D coordinates flat list in points list
;;; (3d-coord->pt-lst ‘(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst (lst)
(if lst
(cons (list (car lst) (cadr lst) (caddr lst))
(3d-coord->pt-lst (cdddr lst))
)
)
)

;;;*************************************************************;;;

;;; SUBLST Returns a sub list
;;; First item : 1
;;; (sublst ‘(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst ‘(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)

(defun sublst (lst start leng / rslt)
(if (not (<= 1 leng (- (length lst) start)))
(setq leng (- (length lst) (1- start)))
)
(repeat leng
(setq rslt (cons (nth (1- start) lst) rslt)
start (1+ start)
)
)
(reverse rslt)
)

;;;*************************************************************;;;

;;; VEC1 Returns the singleunit vector from p1 to p2

(defun vec1 (p1 p2)
(if (not (equal p1 p2 1e-009))
(mapcar ‘(lambda (x1 x2)
(/ (- x2 x1) (distance p1 p2))
)
p1
p2
)
)
)

;;;*************************************************************;;;

;;; BUTLAST List but last item

(defun butlast (lst)
(reverse (cdr (reverse lst)))
)
[/sourcecode]

  • DTM.vlx Despite the fact that I use Civil 3D for this job, DTM is a cool lisp that its main purpose is to create a Digital Terrain. Initially the code was written by Daniele Piazza (a cool guy from Italy http://www.pdcode.com/) and can be downloaded here http://www.cadstudio.cz/en/apps/dtm/ The page also provides useful information on how to use the program.
  • scalexyz.vlx Another supercool program that many people will appreciate (Code not provided). It does all that it says: Scales the drawing’s x,y,z independently!!! Just load it and type scalexyz to activate it!!! Can be downloaded from here http://www.cadstudio.cz/en/download.asp?file=ScaleXYZ

Comments

One response to “5 Great AutoLISP Scripts”

  1. […] I have written a LISP script that allowed the user to export points to a file. It could be found here  .Recently, I changed the code of this script and I am using the command “getfiled” that allows […]

Leave a Reply

Your email address will not be published. Required fields are marked *