Free LISP routines [Archive]

CADTutor

2nd Dec 2002, 11:40 pm

Free LISP routines?

Check out http://www.dotsoft.com/freestuff.htm

vizwhiz

3rd Dec 2002, 05:28 am

hi There

David

say i got some Lisp routines
wrote them myself and use them myself

now that my email and Enternot connection
is back up and running (just after i find some income)

i will gladly send along some useful stuff
Uncle Randy's Handy Dandy Lisp Routines

(free = good price)

Thanks

vizwhiz

CADTutor

3rd Dec 2002, 11:25 am

That's great, I'd like to get a little free LISP library going here at CADTutor. You can always email me direct with an attachment.

Thanks

vizwhiz

10th Dec 2002, 04:54 am

hi There

David and All

here is a small Lisp Code fragment (full routine)
That i use almost daily (hourly) it is so simple too

load the lisp (you can rename it if you like)
Then type MTC which stands for > Match Command

select an Entity on the Screen, and voila
you are not only on that Layer of the Entity

but you are also in that Command that created that Entity
sort of like EDIT command but This could be called DOIT > do it

****

i took out the TEXT subroutine that was referenced

(Next Time)

;;;;-----------------------------------------------------------

;;; select an Item on The Screen
;;; to not only set the Entity's Layer current
;;; but to also set That Entity's Command current

;;;;-----------------------------------------------------------

(defun C:MTC (/ SS DC LA EC)
(setq EC (entsel "Entity to match Command: "))
(setq CM (cdr (assoc 0 (entget (car EC)))))
(setq BK (cdr (assoc 2 (entget (car EC)))))
(setq LA (cdr (assoc 8 (entget (car EC)))))
(setq x41 (cdr (assoc 41 (entget (car EC)))))
(setq y42 (cdr (assoc 42 (entget (car EC)))))
(setq z43 (cdr (assoc 43 (entget (car EC)))))
(command "layer" "s" LA "")
(prompt (strcat "\nCommand Set to: Command: " CM ", Layer: " LA " :"))
(cond
((eq CM "DIMENSION") (command ".dim"))
((eq CM "VIEWPORT") (command ".mview"))
((eq CM "HATCH") (command ".bhatch" "p" bk x41 "" pause))
((eq CM "INSERT") (command ".insert" bk pause x41 y42))
((eq CM "LWPOLYLINE") (command ".pline"))
((eq CM "3DSOLID") (command ".box"))
((eq CM "AEC_WALL") (command "_AecWallAdd"))

;;;; This is where you can add your own Ideas <right here>
;;;; ((eq CM "GO-FOR-IT") (command "go-for-it"))

(T (command cm))
)
(princ)
)

;;; This better work let me know if it doesnt
;;; original code by randy l. sanders c 1995
;;; a simple idea that could be expanded upon
;;; too much time on my my hands one fine day
;;; this took about 15 minutes to put together

fuccaro

6th Jan 2003, 12:06 pm

All time it�s good to be cautious. If somebody redefine AutoCAD commands, the AuotoLISP routines may work in unexpected manner. If the AutoLISP is sending parameters to AutoCAD using the (command) function, it�s a good idea to force the AutoCAD to use the original command. From now I will write my lisp routines according with this observation. If you redefined AutoCAD commands and you begin to have problems with lisp routines, try this:
Open the LSP file with any text editor. Search for the string command. You should find something like
Command �line�
-between quote marks it could be line or other AutoCAD command. Put a point (.) before the commands name, like:
Command �.line�
Make this change for every appearance of Command �AutoCAD-command�
For help the people using AutoCAD in foreign languages, I will write from now in my Lisp routines:
Command �_.AutoCAD-command�
Thanks for those of you sent me observations.

fuccaro

17th Jan 2003, 07:54 am

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;
; STRETCH A 2D POLYLINE (0ONLY LINE SEGMENTS, NO ARCS!) BY SCALING IT ;
; ALONG THE OY AXIS. ;
; Feel free to copy/share this routine, but please respect my work ;
; and respect your self; don't delete/modify this header. ;
; Thank you! Fuccaro Miklos mfuccaro@hotmail.com ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;

(defun C:scy()
(setq en (car (entsel "\nselect your polyline")) en (entget en) i 1)
(setq sc (getreal "\nY scale "))
(setq y0 (cadr (getpoint "\nbase point? ")))
(setq oldsnap (getvar "osmode"))
(command "_.pline")
(repeat (length en) (setq pa (nth (setq i (1+ i)) en))
(setq a (car pa))
(if (= a 10)
(progn
(setq b (cdr pa)
y1 (+ y0 (* sc (- (cadr b) y0)))
b (list (car b) y1))
(command b))))
(command "")
(command "_.zoom" "e")
(setvar "osmode" oldsnap))

**************
* BUG RIPORT *
**************
OOOOOOOPS!
The program will generate always an open polyline. If the original curve is a closed one, you will need to close the generated curve manually (PEDIT ->CLOSE)
Sorry!

fuccaro

24th Feb 2003, 01:42 pm

In AutoCAD 2002 you may save the layers configuration. For AutoCAD 2000, the program bellow save some information in a text file placed in the same directory where your dwg is. The file names Drawingname.LAY and contains information in �readable� form �it is openable with Notepad. You may restore the saved layer configuration.
Limitations:
- If you save the configuration and you delete layers, the routine can not handle the situation.
-This version can save/restore just the color, the on/off and the frozen/thaw status.
-Here is no error handling routine.
-If you move the dwg file you must move the lay file with.
- Testing the routine I encountered problems with frozen layers, so please let me know about your experience if you use this routine
- It is tested only under AutoCAD 2000 (and more tests are required!)

; save-restore layer configuration
; feb. 2003 fuccaro@hotmail.com
;
(defun C:lu() ;L A Y E R U T I L I T Y
(setq old (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(initget 1 "Save Restore")
(setq option (getkword "\nSave Restore ")
filename (strcat (getvar "DWGPREFIX")
(substr (getvar "DWGNAME") 1 (- (strlen (getvar "DWGNAME")) 3))
"LAY"))
(if (= option "Save") (save) (restore))
(setvar "CMDECHO" old)
(princ)
) ;lu

(defun restore()
(if (not (findfile filename)) (princ "\n Nothing to restore")
(progn
(setq position (ask_nr))
(setq file (open filename "r"))
(repeat (1- position)
(read-line file)
(setq nr (atoi (substr (read-line file) 10)))
(repeat (* 5 nr) (read-line file)))
(read-line file)
(setq l (atoi (substr (read-line file) 10)))
(repeat l
(restore1)
(read-line file))
(close file)
) ;progn
))

(defun ask_nr()
(setq file (open filename "r") pos 0 line (read-line file))
(while line
(if (= (substr line 1 1 ) ">")
(progn
(setq pos (1+ pos))
(princ (strcat "\n" (itoa pos) line))))
(setq line (read-line file)))
(close file)
(textscr)
(setq wrong_input T)
(initget (+ 1 2 4))
(while wrong_input
(setq desired_pos (getint "\n Enter number of configuration to restore"))
(setq wrong_input (if (> desired_pos pos) T nil)))
(graphscr)
(eval desired_pos)
) ;ask_config

(defun restore1()
(setq layer (substr (read-line file) 8)
color (substr (read-line file) 8)
frosen (substr (read-line file) 8)
on (substr (read-line file) 8))
(command "_.-layer" "c" color layer)
(if (= frosen "YES") (command "f" layer) (command "t" layer))
(if (= on "YES") (command "ON" layer) (command "OFF" layer))
(command "")
) ;restore1

(defun save()
(setq a (tblnext "layer" T) la nil)
(while a (setq la (cons a la) a (tblnext "layer")))
(setq wrong_input T)
(while wrong_input
(setq name (strcat "> " (getstring T "\nname for this layer config? ") " <"))
(setq file (getfile)))
(write-line name file)
(write-line (strcat "layer(s):" (itoa (length la))) file)
(foreach a la
(setq frozen (cdr (assoc 70 a))
name (cdr (assoc 2 a))
color (abs (cdr (assoc 62 a)))
off (minusp (cdr (assoc 62 a))))
(write-line (strcat "name :" name) file)
(write-line (strcat "color :" (itoa color)) file)
(write-line (strcat "frozen:" (if (or (= frozen 3) (= 1 frozen)) (eval "YES") (eval "NO"))) file)
(write-line (strcat "On :" (if off (eval "NO") (eval "YES"))) file)
(write-line (if (= a (last la)) (eval "----------") (eval "")) file)
);foreach
(close file)
) ;save

(defun getfile()
(setq wrong_input nil)
(if (findfile filename)
(progn
(setq file (open filename "r"))
(test_imput)
(close file)
(open filename "a"))
(open filename "w"))
) ;getfile

(defun test_imput()
(setq l (read-line file))
(while l
(if (= l name)
(progn
(setq wrong_input T)
(prin1 "\n EXISTENT NAME!")))
(setq l (read-line file))
)
) ;test_imput

fuccaro

4th Mar 2003, 10:44 am

This routine is for create arc aligned text and it is tested with AutoCAD 2000. It is not so simple to use as the Express Tools routine is, but this one is for free. I will appreciate any feed back.

; CREATE ARC ALIGNED TEXT
; February 2003 fuccaro@hotmail.com
; !!! works only in WCS !!!
;
(defun C:aralt( / selection arc content hand textlist)
;aralt = ARc ALigned Text
(setq selection nil)
(while (not selection)
(setq selection (entsel "\nSelect arc")))
(setq arc (entget (car selection))
content (getstring T " Enter the text> ")
hand (cdr (assoc -1 arc)) ; arc handle
textlist
(list
(cons 0 "ARCALIGNEDTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbArcAlignedText")
(cons 1 content)
(cons 2 "txt")
(cons 3 "")
(cons 7 "Standard")
(assoc 10 arc)
(assoc 40 arc)
(cons 41 1.0)
(cons 42 (getvar "TEXTSIZE"))
(cons 43 0)
(cons 44 0)
(cons 45 0.0)
(cons 46 0.0)
(assoc 50 arc)
(assoc 51 arc)
(cons 70 0) ; CHARACTERS ORDER
(cons 71 1) ; DIRECTION
(cons 72 1) ; ALIGNMENT
(cons 73 1) ; SIDE
(cons 74 0) ; BOLD
(cons 75 0) ; ITALIC
(cons 76 0) ; UNDERLINE
(cons 77 1)
(cons 78 0)
(cons 79 1)
(cons 90 256)
(list 210 0.0 0.0 1.0)
(cons 280 1)
(cons 330 hand)
))
(entmake textlist)
(princ)
)

CADTutor

4th Mar 2003, 05:08 pm

I tried this out on AutoCAD 2000 in WCS. I get the prompt for arc, select OK and then prompt for text, entered - and then nothing, just "Comand:" No text appears. Am I doing something wrong?

fuccaro

5th Mar 2003, 08:27 am

It is true!
I was very happy to find over the net the DXF codes for the ARCALIGNEDTEXT. Using the Express Tool, probable is loaded first an other application to help AutoCAD to recognize this entity �otherwise it does not work.
I tested my routine and it worked, but first I used the Express tools in that session.
Well, I have more to learn ... Sorry, the routine above is useless!

fuccaro

12th Mar 2003, 02:53 pm

My latest work for this forum: using this lisp routine you can extrude a polyline and twist the result in the same time. It is not a real extrusion in the AutoCAD way, as long as this routine generate surfaces. As all my routines, this too has its limits:
- The polyline must be constructed from line segments, arcs are not welcomed.
- In AutoCAD here is a limit for the mesh size. If your polyline contains more than 255 points, you will need to break it in more smaller polylines and work separately.
Thank you CADTutor for testing the routine.
I will appreciate any feed back!

; Extrude and rotate a polyline in the same time
; generating a SURFACE
; fuccaro@hotmail.com
;
(defun C:etw( / h shapelist vertlist dist ang cent i dx dy oldsnap j newpoint)
; etw = Extrude and TWist
(setq h (getvar "SURFTAB1") ; User may set SURFTAB1 for adjust the quality
shapelist (entget (car (entsel "select poliline")))
vertlist nil
dist (/ (getdist " extrude length?") (1- h))
ang (/ (* PI (getreal "twist angle")) (* (1- h) 180.0))
cent (if (zerop ang) (list 0 0) (getpoint "point on rotation axe?")))
(foreach i shapelist ; Extracting...
(if (= (car i) 10) (setq vertlist (cons (cdr i) vertlist)))) ; vertexes.
(if (not (zerop (cdr (assoc 70 shapelist)))) ; If closed pline...
(setq vertlist (cons (last vertlist) vertlist))) ; final vertex added.
(setq oldsnap (getvar "OSMODE") j 0)
(setvar "OSMODE" 0)
(command "3Dmesh" h (length vertlist))
(repeat (1+ h)
(foreach i vertlist
(setq dx (- (car i) (car cent)) ; Coorrdinates relatif to
dy (- (cadr i) (cadr cent)) ; rotation center
newpoint (polar cent
(+ (* j ang) (atan dy dx))
(sqrt (+ (* dx dx) (* dy dy)))))
(command (list (car newpoint) (cadr newpoint) (* j dist)))
); foreach
(setq j (1+ j))
); repeat
(setvar "OSMODE" oldsnap)
)