AutoLISP Tips and Tricks

Correttore ortografico per AutoCAD 12. Una lista con le parole più ricorrenti è usata dal programma per controllare le parole presenti nella finestra di selezione. La lista, memorizzata nel file c:\pick\lisp\INDICE.TXT, è creata e aggiornata dall'utente nel corso della procedura.

ORTOG.LSP by Claudio Piccini
12 Maggio 1997
FUNZIONE c:ortog
Correttore ortografico per AutoCAD 12.
File data base: C:\PICK\LISP\INDICE.TXT

(defun *error* (msg) (ripVar) (princ msg) (princ) )

(defun salVar () (setq orto (getvar "orthomode")) (setq snapp (getvar "osmode")) (setq snm (getvar "snapmode")) (setq piano (getvar "clayer")) )

(defun ripVar () (command "_redraw") (setvar "cmdecho" 1) (setvar "osmode" snapp) (setvar "snapmode" snm) (setvar "orthomode" orto) (setvar "clayer" piano) (setvar "cecolor" "BYLAYER") (setvar "plinewid" 0.0) (princ) )

(defun selezione ()
(setq p1 (getpoint "\n Primo punto finestra di selezione:"))
(initget 32) ;linea tratteggiata
(setq p2 (getcorner p1 "\n Secondo punto finestra:"))
(if (> (car p2)(car p1))
(setq s1 (ssget "W" p1 p2))
(setq s1 (ssget "C" p1 p2))
)
(setq lt (ssget "P" '((0 . "TEXT"))))
(setq f1 (open nomefile "r"))
(setq OK (findfile nomefile)) ;esiste?
(if (/= OK nil)
(progn
(setq riga "")
(while (/= riga nil)
(setq riga (read-line f1))
(if (/= riga nil) (setq ldb (append ldb (list riga))) )
)
(close f1)
(setq ldb (cdr ldb)) ; elimina nil dal database
)
)
(menuOrtog)
)

(defun menuOrtog ()
(setq Lldb (length ldb))
(setq Llt (sslength lt))
(setq indice 0)
(repeat Llt ; cicla per n parole in lt (gruppo ricavato da s1)
(setq testo (entget (ssname lt indice)))
(setq Plt (cdr (assoc 1 testo)))
(setq pntInizio (cdr (assoc 10 testo)))
(setq hTesto (cdr (assoc 40 testo)))
(if (wcmatch Plt "* *")
(progn
(cercaStringa) ;se e' una stringa di parole
(cicloParole)
)
(cercaParola) ;se e' una singola parola
)
(setq indice (+ indice 1))
)
(cicloToken) ;solo per singole parole
)

(defun cercaParola ()
(setq Plt (strcase Plt))
(setq manca 0)
(setq n 0)
(repeat Lldb
(setq Pdb (nth n ldb))
(if (= Pdb Plt)
(setq manca 1)
)
(setq n (+ n 1))
)
(if (= manca 0) ;se la parola non e' stata trovata
(progn
(setq tokenAssente (append tokenAssente (list Plt)))
(setq ltpnt (append ltpnt (list pntInizio)))
(setq ltHtxt (append ltHtxt (list hTesto)))
)
)
)

(defun cercaStringa ()
(setq n1 1)
(setq n2 1)
(setq n3 1)
(setq n4 0)
(setq nCarSpazi (strlen Plt))
(repeat nCarSpazi
(setq str (substr Plt n1 n2))
(if (wcmatch str "* *")
(progn
(setq inizio n1)
(setq fine (- n2 1))
(setq parola (substr Plt inizio fine))
(setq listaToken (append listaToken (list parola)))
(setq n1 (+ n3 1))
(setq n2 0)
(setq n4 (+ n3 1) )
)
)
(setq n2 (+ n2 1))
(setq n3 (+ n3 1))
)
(setq parola (substr Plt n4))
(setq listaToken (append listaToken (list parola)))
(setq listaToken (cdr ListaToken)) ;elimina nil
(setq LlistaToken (length listaToken))
(setq Lldb (length ldb))
(setq n 0)
(repeat LlistaToken
(setq token (nth n listaToken))
(setq STAMPATELLO (strcase token))
(setq nn 0)
(repeat Lldb
(setq Pdb (nth nn ldb))
(if (= Pdb STAMPATELLO)
(setq lPostoStr (append lPostoStr (list token)))
)
(setq nn (+ nn 1))
)
(setq n (+ n 1))
)
)

(defun cicloParole ()
(spunta)
(setq lPostoStr (cdr lPostoStr)) ;elimina nil
(setq LlPostoStr (length lPostoStr))
(setq LlistaToken (length listaToken))
(setq k 0)
(repeat LlistaToken
(setq kkk 0)
(setq token (nth k listaToken))
(setq STAMPATELLO (strcase token))
(setq nDB 0)
(setq y 0)
(repeat LlPostoStr
(setq cPosto (nth y lPostoStr))
(if (= cPosto token)
(setq nDB 1)
)
(setq y (+ y 1))
)
(if (= nDB 0) ;se la parola non c'e' nella lista
(progn
(setq ndop 0)
(setq nlistPar (length listPar))
(repeat nlistPar
(setq doppione (nth ndop listPar))
(if (= doppione STAMPATELLO)
(setq kkk 1)
)
(setq ndop (+ 1 ndop))
)
(if (= kkk 0) ;se token-STAMPATELLO non e' un doppione
(progn
(princ "\n")(princ "? ")(princ token)
(initget "C c A a I i")
(setq ss (getkword "\nCambia/Aggiungi/Ignora (c/a/i) <i>: "))
(cond
((or (= ss "C")(= ss "c"))
(setq ss "C")
(setq w 1)
(while w
(setq strsos (getstring "\nSostituire con: "))
(if (/= strsos "")
(setq w nil)
)
)
(setq listaToken (subst strsos token listaToken))
)
((or (= ss "A")(= ss "a"))
(setq ss "A")
(setq f1 (open nomefile "a"))
(princ STAMPATELLO f1) (princ "\n" f1)
(close f1)
(setq listPar (append listPar (list STAMPATELLO)))
)
((or (= ss "I")(= ss "i"))
(setq listPar (append listPar (list STAMPATELLO)))
)
( T (setq ss "I")
(setq listPar (append listPar (list STAMPATELLO)))
)
)
)
)
)
)
(setq k (+ k 1))
)
(setq token (nth 0 listaToken))
(setq parola token)
(setq k 1)
(setq LlistaToken (- LlistaToken 1))
(repeat LlistaToken
(setq token (nth k listaToken))
(setq parola (strcat parola " " token))
(setq k (+ k 1))
)
(setq lstrtxt (assoc 1 testo))
(setq lparola (cons 1 parola))
(setq testo (subst lparola lstrtxt testo))
(entmod testo)
(setq listaToken (list nil)) ;annulla la lista delle parole nella frase
(setq lPostoStr (list nil)) ;annulla la lista delle parole conosciute
(entdel spuntaVerde)
(command "_redraw")
)

(defun cicloToken ()
(setq annulla 0)
(setq k 0) ; contatore per la lista tokenAssente
(setq ltpnt (cdr ltpnt)) ; elimina nil
(setq ltHtxt (cdr ltHtxt)) ; elimina nil
(setq tokenAssente (cdr tokenAssente)) ; elimina nil
(setq LtokenAssente (length tokenAssente))
(repeat LtokenAssente ; cicla per il numero di parole ignote
(if (= annulla 0)
(progn
(setq kkk 0) ; contatore per parole multiple
(setq token (nth k tokenAssente)) ; parola sconosciuta
(setq pntInizio (nth k ltpnt)) ; punto inizio parola
(setq hTesto (nth k ltHtxt)) ; altezza testo
(setq ndop 0) ; contatore parole multiple
(setq nlistPar (length listPar))
(repeat nlistPar
(setq doppione (nth ndop listPar))
(if (= token doppione)
(setq kkk 1)
)
(setq ndop (+ 1 ndop))
)
(if (= kkk 0)
(progn
(spunta)
(princ "\n")(princ "? ")(princ token)
(initget "C c T t A a I i X x")
(setq ss (getkword "\nCambia/cambia Tutto/Aggiungi/Ignora/eXit (c/t/a/i/x) <i>: "))
(cond
((or (= ss "C")(= ss "c"))
(setq ss "C")
(sost)
)
((or (= ss "T")(= ss "t"))
(setq ss "T")
(entdel spuntaVerde)
(command "_redraw")
(sosTutto)
)
((or (= ss "A")(= ss "a"))
(setq ss "A")
(aggiunge)
)
((or (= ss "X")(= ss "x"))
(setq ss "X")
(entdel spuntaVerde)
(command "_redraw")
(setq annulla 1)
)
((or (= ss "I")(= ss "i"))
(entdel spuntaVerde)
(command "_redraw")
(setq listPar (append listPar (list token)))
)
( T (setq ss "I")
(entdel spuntaVerde)
(command "_redraw")
(setq listPar (append listPar (list token)))
)
)
)
)
)
)
(setq k (+ k 1))
)
)

(defun spunta ()
(command "_color" "3")
(cond
((<= hTesto 0.50)
(setq pc (list (- (car pntInizio) 0.2) (cadr pntInizio)))
(setq ps (list (- (car pc) 0.1) (+ (cadr pc) 0.2)))
(setq pd (list (+ (car pc) 0.1) (+ (cadr pc) 0.3)))
(command "_pline" ps "_w" 0.1 0.1 pc pd "")
)
((and (> hTesto 0.50)(<= hTesto 1))
(setq pc (list (- (car pntInizio) 0.4) (cadr pntInizio)))
(setq ps (list (- (car pc) 0.3) (+ (cadr pc) 0.5)))
(setq pd (list (+ (car pc) 0.3) (+ (cadr pc) 0.7)))
(command "_pline" ps "_w" 0.2 0.2 pc pd "")
)
((and (> hTesto 1)(<= hTesto 4))
(setq pc (list (- (car pntInizio) 0.6) (cadr pntInizio)))
(setq ps (list (- (car pc) 0.6) (+ (cadr pc) 0.8)))
(setq pd (list (+ (car pc) 0.6) (+ (cadr pc) 1.1)))
(command "_pline" ps "_w" 0.3 0.3 pc pd "")
)
((> hTesto 4)
(setq pc (list (- (car pntInizio) 2) (cadr pntInizio)))
(setq ps (list (- (car pc) 1.6) (+ (cadr pc) 1.8)))
(setq pd (list (+ (car pc) 1.6) (+ (cadr pc) 2.2)))
(command "_pline" ps "_w" 0.6 0.6 pc pd "")
)
)
(setq spuntaVerde (entlast))
)

(defun sost ()
(setq indice 0)
(setq j 1)
(while j
(setq testo (entget (ssname lt indice)))
(setq lstrtxt (assoc 1 testo))
(setq strtxt (strcase (cdr lstrtxt)))
(if (= strtxt token)
(progn
(setq listE (append listE (list testo)))
(setq w 1)
(while w
(setq strsos (getstring "\nSostituire con: "))
(if (/= strsos "")
(setq w nil)
)
)
(setq lstrsos (cons 1 strsos))
(setq testo (subst lstrsos lstrtxt testo))
(entmod testo)
(setq listE (cdr listE)) ;elimina nil
(setq testo (cdr (car (nth 0 listE))))
(ssdel testo lt) ;cancella l'entita' dalla lista lt
(setq j nil)
)
)
(setq indice (+ indice 1))
)
(setq listE (list nil)) ;azzera la lista
(entdel spuntaVerde)
(command "_redraw")
)

(defun sosTutto ()
(setq contaP 0) ; contatore per listPar
(setq numEnt (sslength lt))
(setq indice 0)
(repeat numEnt
(setq testo (entget (ssname lt indice)))
(setq lstrtxt (assoc 1 testo))
(setq strtxt (strcase (cdr lstrtxt)))
(if (= strtxt token)
(progn
(setq lcambiaParole (append lcambiaParole (list testo)))
(setq listE (append listE (list testo)))
(if (= contaP 0)
(progn
(setq listPar (append listPar (list token)))
(setq contaP 1)
)
)
)
)
(setq indice (+ indice 1))
)
(setq lcambiaParole (cdr lcambiaParole)) ;elimina nil
(setq listE (cdr listE)) ;elimina nil
(setq nPsos (length lcambiaParole))
(setq w 1)
(while w
(setq strsos (getstring "\nSostituire con: "))
(if (/= strsos "")
(setq w nil)
)
)
(setq lstrsos (cons 1 strsos))
(setq num 0)
(repeat nPsos
(setq entSos (nth num lcambiaParole))
(setq lstrtxt (assoc 1 entSos))
(setq strtxt (strcase (cdr lstrtxt)))
(setq entSos (subst lstrsos lstrtxt entSos))
(entmod entSos)
(setq testo (cdr (car (nth num listE))))
(ssdel testo lt)
(setq num (+ 1 num))
)
(setq lcambiaParole (list nil)) ;cancella tutte le parole
(setq listE (list nil)) ;elimina tutti i riferimenti alle entita' cambiate
)

(defun aggiunge ()
(setq f1 (open nomefile "a"))
(princ token f1)
(princ "\n" f1)
(close f1)
(setq listPar (append listPar (list token)))
(entdel spuntaVerde)
(command "_redraw")
)

(defun c:ortog (/ p1 p2 s1 lt f1 OK riga ldb Lldb Llt indice testo Plt pntInizio hTesto annulla manca n tokenAssente ltpnt ltHtxt n1 n2 n3 n4 nCarSpazi str inizio fine parola listaToken LlistaToken k STAMPATELLO LtokenAssente kkk token ndop nlistPar listPar doppione ss pc ps pd j lstrtxt strtxt listE w lstrsos contaP numEnt lcambiaParole num nPsos strsos entSos nn lPostoStr LlPostoStr cPosto y nDB snm snapp orto piano
)
(salVar)
(setvar "cmdecho" 0)
(command "osnap" "_non")
(setq nomefile "c:/pick/lisp/indice.txt")
(setq ldb (list nil))
(setq ltpnt (list nil))
(setq ltHtxt (list nil))
(setq tokenAssente (list nil))
(setq listaToken (list nil))
(setq lPostoStr (list nil))
(setq lcambiaParole (list nil))
(setq listE (list nil))
(selezione)
(ripVar)
)

Estrazione di elementi dalle liste

LISP significa LISt Processing. Una list è un gruppo di elementi qualsiasi tra parentesi, ed è memorizzata come una variabile singola.
Una lista di AutoLISP può contenere un numero qualsiasi di valori reali, interi, stringhe di caratteri, variabili e altre liste.
Tutto ciò che è compreso tra una coppia di parentesi è una lista.
Se non vuoi perderti tra le parentesi del LISP (Lost-In-Stupid-Parentheses) devi usare le funzioni CAR di AutoLISP.

car	Restituisce il primo elemento di una lista (list). Utile ad esempio per estrarre da una lista la coordinata X di un punto.	(car list)
cadr	Restituisce il secondo elemento di una lista. Utile per estrarre da una lista la coordinata Y di un punto.	(cadr list)
caddr	Restituisce il terzo elemento di una lista. Utile per estrarre da una lista la coordinata Z di un punto.	(caddr list)
cdr	Restituisce la lista priva del primo elemento.	(cdr list)
c????r	Restituisce un elemento o una lista dalla lista, specificato mediante una combinazione tra il primo elemento (A) e quelli rimanenti (D) nell'espressione c????r. Ad esempio (cdr (car list)) equivale a (cdar list).	(c????r list)

Come eliminare gli spazi da un file LISP

Apri il file sorgente LSP con il Blocco Note di Win e aggiungi all'inizio del file i tag:

e in fondo al file i tag:

</body>
</html>

Elimina tutti i commenti presenti nel codice sorgente. Rinomina il file da nome.lsp in nome.htm. Il browser visualizzerà il codice sorgente (nell'esempio il codice del gestore degli errori) senza gli spazi di tabulazione.

(defun myerror (s) (if (/= s "Function cancelled") (princ (strcat "\nError: " s)) ) (ripVar) (princ) ) (defun salVar () (setq orto (getvar "orthomode")) (setq snapp (getvar "osmode")) (setq snm (getvar "snapmode")) (setq piano (getvar "clayer")) ) (defun ripVar () (command "_redraw") (setvar "cmdecho" 1) (setvar "osmode" snapp) (setvar "snapmode" snm) (setvar "orthomode" orto) (setvar "clayer" piano) (setq *error* olderr) (princ) ) (funz1 () (princ) ) (defun C:XYZ (/ olderr snapp snm orto piano ) (setq olderr *error* *error* myerror) (setvar "cmdecho" 0) (salVar) (funz1) (ripVar) )

Seleziona tutto il testo, copia e incolla nel Blocco Note di Windows, quindi salva il file come LSP.

Come calcolare l'area di un vano chiuso

;picka.lsp
;Pick 2.3 (C) 1996-2001 by Claudio Piccini.

...

(defun stnum (num dec / str un)
 (setq un (getvar "luprec"))
 (setvar "luprec" dec)
 (setq str (rtos num))
)

(defun c:picka ( / p1 pl1 nSup cSup)
 (setvar "cmdecho" 0)
 (funzione salva Variabili)
 ;off layer superflui
 (command "_layer" "_s" "0" "_off" "x,y,z,..." "")
 (command "_color" "1")
 (command "osnap" "_non")
 (initget 1)
 (setq p1 (getpoint "\n Clicca all'interno del vano:"))
 (command "_bpoly" p1 "")
 (setq pl1 (entlast))
 (command "_area" "_e" pl1)
 (setq nSup (getvar "area"))
 (setq cSup (stnum nSup 3)) 
 (princ "\n Area: ")
 (princ cSup)
 (initget "s S")
 (getkword " ")
 (entdel pl1)
 (command "_color" "BYLAYER")
 ;on layer
 (command "_layer" "_on" "x,y,z,..." "")
 (funzione ripristina Variabili)
)

Un gestore degli errori

(defun myerror (s)                  
 (if (/= s "Function cancelled")
  (princ (strcat "\nError: " s))
 )
 (ripVar)
 (princ)
)

(defun salVar ()
 (setq orto (getvar "orthomode"))                          
 (setq snapp (getvar "osmode"))
 (setq snm (getvar "snapmode"))
 (setq piano (getvar "clayer"))  
)

(defun ripVar ()
 (command "_redraw")
 (setvar "cmdecho" 1)
 (setvar "osmode" snapp)
 (setvar "snapmode" snm)
 (setvar "orthomode" orto)
 (setvar "clayer" piano)
 (setq *error* olderr)
 (princ)
)

(funz1 ()
 ...
)

(defun C:XYZ (/ olderr snapp snm orto piano
 )
 (setq olderr *error* *error* myerror)
 (setvar "cmdecho" 0)
 (salVar)
 (funz1)
 (ripVar)
)

Lisp »Tips 'n Tricks