 |
|
Exchange Forum >
AutoLISP and Visual LISP
Useful AutoLISP functions |
|
|
|
|
|
| Useful AutoLISP functions |
#1 |
|
|
Flynn |
 |
|
Join Date: |
|
07-24-2007 | |
I like Bennett’s idea for the thread for “Your favorite shortcut function”. It builds a library of useful shortcut functions that everyone can add to and learn from. In this thread you are welcome to add your favorite AutoLISP functions that may be useful for others. I’m not setting any limit here to get this library going. If you have a more efficient version of a function that has already been posted, please submit your version also. This library of AutoLISP functions is for all of us to learn from and to benefit from. Please explain what your AutoLISP function does, and if necessary describe the type of the arguments, and what the AutoLISP function returns.
I’ll start with two AutoLISP functions that have been around since day one, and I have no idea who wrote them.
The function dtr returns the radians of the argument degrees.
Code:
(defun dtr (degrees)
(* pi (/ degrees 180.0))
)
The function rtd returns the degrees of the argument radians.
Code:
(defun rtd (radians)
(* 180.0 (/ radians pi))
)
| |
|
| Useful AutoLISP functions |
#2 |
|
|
Bennett |
 |
|
Join Date: |
|
07-26-2007 | |
Excellent idea Flynn! Here are a few trig related functions that I've found very useful.
The acos function returns the acos of the argument x, a real number between 0 and 1.
Code:
(defun acos (x)
(atan (/ (sqrt (- 1 (* x x))) x))
)
The asin function returns the arcsin of the argument sine, a real number between -1 and 1.
Code:
(defun asin (sine / cosine)
(setq cosine (sqrt (- 1.0 (expt sine 2))))
(if (zerop cosine)
(setq cosine 0.000000000000000000000000000001)
)
(atan (/ sine cosine))
)
The tan function returns the tangent of radians argument.
Code:
(defun tan (radians)
(/ (sin radians) (cos radians))
)
| |
|
| Useful AutoLISP functions |
#3 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
Here my version
Code:
; adil is stand for add degree in list
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 21 March 2006
; Program no.: 0344/03/2006
; Edit by
; MODEL 1
(setq lst '(10 20 30 40 50 60 70 80 90 100 110 120))
; add degree in list
(defun adil (lst / deg tdeg)
(foreach x lst
(setq deg (strcat (itoa x)(chr 432)))
(setq tdeg (append tdeg (list deg)))
)
)
(adil lst) ; => ("10°" "20°" "30°" "40°" "50°" "60°" "70°" "80°" "90°" "100°" "110°" "120°")
; MODEL 2
(setq lst '(1 2 3 4 5 6 7 8 9 10))
; add degree in list
(defun adil (lst / len cnt lis deg num tnum)
(setq len (length lst))
(setq cnt 0)
(repeat
len
(setq lis (nth cnt lst))
(setq deg (chr 432))
(setq num (strcat (itoa lis) deg))
(setq tnum (append tnum (list num)))
(setq cnt (1+ cnt))
)
(princ tnum)
)
(adil lst) ; => ("1°" "2°" "3°" "4°" "5°" "6°" "7°" "8°" "9°" "10°")
| |
|
| Useful AutoLISP functions |
#4 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
This code to extract a string from completed string,look like this below.
Code:
; ssx is stand for seacrh string xname
; Design by : Adesu <Ade Suharna>
; Email : mteybid@yuasabattery.co.id
; Homepage : http://www.yuasa-battery.co.id
; Create : 05 February 2006
; Program no.: 324/02/2006
; Edit by : VD 06/02/2006 1).
(defun SSX (item lst / len cnt lis liz)
(setq len (strlen lst))
(setq cnt 1)
(repeat len
(if
(eq item (substr lst cnt 1)) ; 1).
(progn
(setq lis (substr lst cnt 1))
(setq liz (append liz (list lis)))
) ; progn
) ; if
(setq cnt (1+ cnt))
) ; repeat
(print liz) ; 1).
(princ) ; 1).
)
_$ (setq tex "qewdsfdtegrrfhgaafdeqewdsfd")
"qewdsfdtegrrfhgaafdeqewdsfd"
_$ (SSX "e" tex) ; =====> ("e" "e" "e" "e")
_$ (SSX "f" tex) ; =====> ("f" "f" "f" "f")
_$ (SSX "r" tex) ; =====> ("r" "r")
_$ (SSX "d" tex) ; =====> ("d" "d" "d" "d" "d")
| |
|
| Useful AutoLISP functions |
#5 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
here a code from Mr.Puckett,it's vrey useful
Code:
(defun table (s / d r) ; Michael Puckett
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
Purpose
Returns a list containing all entries in the specified symbol table
Arguments
A symbol table name
Example
(table "block")
Notes
None
Author
Michael Puckett
| |
|
| Useful AutoLISP functions |
#6 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
here from Mr.Elpanov
Code:
; by ElpanovEvgeniy
(defun test (lst fun)
(if
(cdr lst)
(test (cons (fun (car lst) (cadr lst)) (cddr lst)) fun)
(car lst)
) ;_ if
) ;_ defun
(setq lst '(1. 2. 3. 4. 5. 6. 7. 8. 9.))
(test lst +) ; => 45.0
(test lst -) ; => -43.0
(test lst *) ; => 362880.0
(test lst /) ; => 2.75573e-006
| |
|
| Useful AutoLISP functions |
#7 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
This from me too
Code:
; by Adesu
(setq lst '("0" "B_STR" "B_BWK" "B_TXT"))
(defun addslash (lst / slh xlst nlst)
(setq slh " ")
(foreach x lst
(setq xlst (strcat x slh "/" slh))
(setq nlst (append nlst (list xlst)))
)
(vl-string-right-trim " /" (apply 'strcat nlst))
)
(addslash lst) ; -> "0 / B_STR / B_BWK / B_TXT"
| |
|
| Useful AutoLISP functions |
#8 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
Here simple to convert a string
Code:
(setq opt (getstring "\nENTER NEW NAME: "))
"Adesu"
(setq listopt (mapcar 'chr (vl-string->list opt)))
("A" "d" "e" "s" "u")
(setq nlis (apply 'strcat listopt))
"Adesu"
| |
|
| Useful AutoLISP functions |
#9 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
From Mr.Tanzillo
Code:
; by Tony Tanzillo <tony.tanzillo at caddzone dot com> 12/2/02
(defun strlcat (delim lst)
(apply 'strcat (cons (car lst)
(mapcar '(lambda (x)(strcat delim x))
(cdr lst)
)
)
)
)
Usage:
(strlcat "," '("A" "B" "C" "D"))
-> "A,B,C,D"
| |
|
| Useful AutoLISP functions |
#10 |
|
|
Adesu |
 |
|
Join Date: |
|
10-03-2007 | |
This code to extract a dxf code
Code:
(setq ss (car (entsel "\nSelect an object")))
(defun dxf (ss code / sse)
(setq sse (entget ss))
(setq dxf (cdr (assoc code sse)))
)
(dxf ss 10)
(setq sp (dxf ss 10)) ; to find start point
;(setq ep (dxf ss 11)) ; to find start point
(setq ent (dxf ss 0)) ; to find entity name
(setq lay (dxf ss 8)) ; to find layer current
(setq col (dxf ss 62)) ; to find current object
(setq ms (dxf ss 67)) ; to find model or paper
| |
|
|
|
|
|