Lisp »Tips 'n Tricks
»Q2L
Q2C traduce un numero con decimali (o più numeri racchiusi in una finestra di selezione) in lettere e lo scrive nel disegno.
Q2C permette di aggiungere (o sottrarre) una quantità numerica dall'insieme dei numeri racchiusi nella finestra di selezione.
Per aggiungere o sottrarre un numero prima della conversione battere il numero altrimenti premere 0 (zero).
Il Lisp contiene (almeno) un errore. Test con Q2C:
Command: q2c
Seleziona una quota : Seleziono un punto nel disegno
Secondo punto della finestra:
Numero (0): 3.29
 Prima del Lisp
 Dopo il Lisp
Q2C legge i numeri con la virgola decimale come interi, e va bene ...
Command: (+ 12,2 1)
; error: bad argument type: numberp: nil
Command: (+ 12.2 1)
13.2
... ma sbaglia nel convertire numeri reali con la parte decimale inferiore a 10.
Esempio -1.23 + 3.29 = 2.6.
Ecco il lisp corretto (con le istruzioni nuove in blu).
Q2L
;|
Q2L Copyright (C) 2005 by Claudio Piccini.
All rights reserved
www.cg-cad.com
Traduce numeri in lettere nel disegno
Es. 145.00 -> centoquarantacinque.00
Limiti:
valore max. 9999999.00
|;
(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)
(setvar "cecolor" "BYLAYER")
(setq *error* olderr)
(princ)
)
(defun n2c ( stringa / lstUnit lstDec lst10_19
segno lstr nc7 i
n0 n1 n2 n3 n4 n5 n6 n7
cNumero str1 str2 str
zero ; es. dieci.06
)
(setq lstUnit
(list
"zero" "uno" "due" "tre" "quattro"
"cinque" "sei" "sette" "otto" "nove"
)
)
(setq lstDec
(list
"zero" "dieci" "venti" "trenta"
"quaranta" "cinquanta" "sessanta"
"settanta" "ottanta" "novanta"
)
)
(setq lst10_19
(list
"zero" "dieci" "undici" "dodici" "tredici" "quattordici"
"quindici" "sedici" "diciassette" "diciotto" "diciannove"
)
)
(if (= (substr stringa 1 1) "-")
(progn
(setq segno "-")
(setq stringa (substr stringa 2)) ; elimina il segno - dalla stringa
)
(setq segno "")
)
(if (wcmatch stringa "*.*") ; se e' un numero reale
(progn
(setq lstr (strlen stringa))
(setq i 1)
(while (< i lstr)
(if (= (substr stringa i 1) ".")
(progn
(setq str1 (substr stringa 1 (1- i)))
(if (= (substr stringa (1+ i) 1) "0")
(setq zero "0")
(setq zero "")
)
(setq n0 (atoi (substr stringa (1+ i))))
(setq i lstr)
(setq stringa str1)
)
(setq i (1+ i))
)
)
)
(setq n0 "no")
)
(setq lstr (strlen stringa))
(setq nc7 (- 7 lstr))
(setq i 0)
(while (< i nc7)
(setq stringa (strcat "0" stringa))
(setq i (1+ i))
)
(setq n1 (atoi(substr stringa 7 1))
n2 (atoi(substr stringa 6 1))
n3 (atoi(substr stringa 5 1))
n4 (atoi(substr stringa 4 1))
n5 (atoi(substr stringa 3 1))
n6 (atoi(substr stringa 2 1))
n7 (atoi(substr stringa 1 1))
)
(cond
((= n7 0)(setq cNumero ""))
((= n7 1)(setq cNumero "unmilione"))
((> n7 1)(setq cNumero (strcat (nth n7 lstUnit) "milioni")))
)
(cond
((= n6 0)(setq cNumero (strcat cNumero ""))) ; spazio
((= n6 1)(setq cNumero (strcat cNumero "cento")))
((> n6 1)(setq cNumero (strcat cNumero (nth n6 lstUnit) "cento")))
)
(if (= n5 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n4 0)
(setq cNumero (strcat cNumero (nth n5 lstDec)))
(if (= n5 1)
(setq cNumero (strcat cNumero (nth (1+ n4) lst10_19) "mila"))
(setq cNumero (strcat cNumero (nth n5 lstDec)))
)
)
)
(if (= n4 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n5 1)
(setq cNumero (strcat cNumero "")) ; spazio
(setq cNumero (strcat cNumero (nth n4 lstUnit)))
)
)
(if (= (+ n4 n5 n6) 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n4 1)
(setq cNumero (strcat cNumero "mille"))
(setq cNumero (strcat cNumero "mila"))
)
)
(if (= n3 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n3 1)
(setq cNumero (strcat cNumero "cento"))
(setq cNumero (strcat cNumero (nth n3 lstUnit) "cento"))
)
)
(if (= n2 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n1 0)
(setq cNumero (strcat cNumero (nth n2 lstDec)))
(if (= n2 1)
(setq cNumero (strcat cNumero (nth (1+ n1) lst10_19)))
(setq cNumero (strcat cNumero (nth n2 lstDec)))
)
)
)
(if (= n1 0)
(setq cNumero (strcat cNumero "")) ; spazio
(if (= n2 1)
(setq cNumero (strcat cNumero "")) ; spazio
(setq cNumero (strcat cNumero (nth n1 lstUnit)))
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*oo*") ; oo->o (es. 980)
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 2) "oo")
(progn
(setq str1 (substr cNumero 1 i))
(setq str2 (substr cNumero (+ i 2)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*tao*") ; tao->to (es. 88)
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 3) "tao")
(progn
(setq str1 (substr cNumero 1 i))
(setq str2 (substr cNumero (+ i 2)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*tiu*") ; tiu->tu (es. 21)
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 3) "tiu")
(progn
(setq str1 (substr cNumero 1 i))
(setq str2 (substr cNumero (+ i 2)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*tio*") ; tio->to (es. 28)
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 3) "tio")
(progn
(setq str1 (substr cNumero 1 i))
(setq str2 (substr cNumero (+ i 2)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*tau*") ; tau->tu (es. 91)
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 3) "tau")
(progn
(setq str1 (substr cNumero 1 i))
(setq str2 (substr cNumero (+ i 2)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(if (= (substr cNumero 1 8) "unomille")
(progn
(setq cNumero (substr cNumero 4))
(setq str (strcat str cNumero))
(setq cNumero str)
(setq str "")
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*mille*")
(progn
(setq i 1)
(while (< i nCar)
(if (and (= (substr cNumero i 5) "mille")(> i 1))
(progn
(setq str1 (substr cNumero 1 (1- i)))
(setq str2 (substr cNumero (+ i 5)))
(setq str (strcat str str1 "mila" str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(if (= (substr cNumero 1 16) "unmilioneunomila")
(progn
(setq str1 (substr cNumero 1 9))
(setq str2 (substr cNumero 17))
(setq str (strcat str str1 "mille" str2))
(setq cNumero str)
(setq str "")
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*milioniunomila*")
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 14) "milioniunomila")
(progn
(setq str1 (substr cNumero 1 (+ i 6)))
(setq str2 (substr cNumero (+ i 14)))
(setq str (strcat str str1 "mille" str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(setq str "")
(setq nCar (strlen cNumero))
(if (wcmatch cNumero "*milamila*")
(progn
(setq i 1)
(while (< i nCar)
(if (= (substr cNumero i 8) "milamila")
(progn
(setq str1 (substr cNumero 1 (1- i)))
(setq str2 (substr cNumero (+ i 4)))
(setq str (strcat str str1 str2))
(setq cNumero str)
(setq str "")
)
)
(setq i (1+ i))
)
)
)
(if (/= n0 "no")
(setq cNumero (strcat segno cNumero "." zero (rtos n0 2 0)))
(setq cNumero (strcat segno cNumero))
)
)
(defun cambiaQuota ( / num1 num2 num3
nOld nNew
numEnt indice tipoEnt
)
(setq ls (cdr ls)) ; elimina nil
(setq numEnt (length ls))
; chiede il numero da sommare o sottrarre
(setq num1 (getreal "\n Numero da sommare o sottrarre (0): "))
(if (= num1 nil)(setq num1 0))
(if (or (/= numEnt 0)(/= s2 nil))
(progn
(if (/= numEnt 0) ; esamina le entita' contenute nella lista ls
(progn
(setq indice 0)
(repeat numEnt
(setq ent1 (entget (nth indice ls)))
(setq tipoEnt (assoc 0 ent1))
(if (= "TEXT" (cdr tipoEnt))
(progn
; estrae il codice. Es (1 . "1.10")
(setq nOld (assoc 1 ent1))
; estrae il numero-stringa. Es "1.10"
(setq num2 (cdr nOld))
(if
(or
(= num2 "0")
(= num2 "0.0")
(= num2 "0.00")
(= num2 "0.000")
(= num2 "0.0000")
(= num2 "0.00000")
(= num2 "0.000000")
)
(progn
(setq num3 (+ 0.0 num1))
; trasforma il numero reale in stringa
(setq num3 (rtos num3 2 2))
(setq num3 (n2c num3)) ; lo converte in lettere
(setq nNew (cons (car nOld) num3))
(setq ent1 (subst nNew nOld ent1))
(entmod ent1)
)
(progn
(if (/= (atof num2) 0.0) ; se non e' una parola
(progn
; trasforma la stringa in un numero reale
(setq num2 (atof num2))
(setq num3 (+ num2 num1))
; trasforma il numero reale in stringa
(setq num3 (rtos num3 2 2))
(setq num3 (n2c num3)) ; lo converte in lettere
(setq nNew (cons (car nOld) num3))
(setq ent1 (subst nNew nOld ent1))
(entmod ent1)
)
)
)
)
)
)
(setq indice (+ indice 1))
)
)
)
(if (/= s2 nil) ; se la finestra di selezione non e' vuota
(progn
(setq numEnt (sslength s2))
(setq indice 0)
(repeat numEnt
(setq ent1 (entget (ssname s2 indice)))
(setq tipoEnt (assoc 0 ent1))
(if (= "TEXT" (cdr tipoEnt))
(progn
; estrae il codice. Es (1 . "1.10")
(setq nOld (assoc 1 ent1))
; estrae il numero-stringa. Es "1.10"
(setq num2 (cdr nOld))
(if
(or
(= num2 "0")
(= num2 "0.0")
(= num2 "0.00")
(= num2 "0.000")
(= num2 "0.0000")
(= num2 "0.00000")
(= num2 "0.000000")
)
(progn
(setq num3 (+ 0.0 num1))
; trasforma il numero reale in stringa
(setq num3 (rtos num3 2 2))
(setq num3 (n2c num3)) ; lo converte in lettere
(setq nNew (cons (car nOld) num3))
(setq ent1 (subst nNew nOld ent1))
(entmod ent1)
)
(progn
(if (/= (atof num2) 0.0)
(progn
; trasforma la stringa in numero reale
(setq num2 (atof num2))
(setq num3 (+ num2 num1))
; trasforma il numero reale in stringa
(setq num3 (rtos num3 2 2))
(setq num3 (n2c num3)) ; lo converte in lettere
(setq nNew (cons (car nOld) num3))
(setq ent1 (subst nNew nOld ent1))
(entmod ent1)
)
)
)
)
)
)
(setq indice (+ indice 1))
)
)
)
)
)
)
(defun C:Q2L (/ olderr k ls s1 p1 p2 s2 ent1
snapp snm orto piano
)
(setq olderr *error* *error* myerror)
(setvar "cmdecho" 0)
(salVar)
(setq ls (list nil))
(command "osnap" "_non")
(command "osnap" "_nea")
(setq k 1)
(while k
(setq p1 (getpoint "\n Seleziona un numero :"))
(if (= p1 nil)
(progn ; se e' stato battuto Invio (nil)...
(setq k nil)
(cambiaQuota)
)
(progn ; se il set non e' vuoto...
(setq s1 (ssget p1))
(if (/= s1 nil)
(progn
(setq ent1 (entget (ssname s1 0)))
(setq ent1 (car ent1))
(setq ent1 (cdr ent1))
(setq ls (append ls (list ent1))) ; aggiorna la lista
)
(progn ; se il set e' vuoto apre una finestra...
(setq k nil)
(initget 32) ; linea tratteggiata
(setq p2 (getcorner p1 "\n Secondo punto della finestra:"))
(if (> (car p2)(car p1))
(progn
(setq s2 (ssget "_W" p1 p2))
(cambiaQuota)
)
(progn
(setq s2 (ssget "_C" p1 p2))
(cambiaQuota)
)
)
)
)
)
)
)
(ripVar)
)
;;;eof
|
Test del Lisp
Command: q2l
Seleziona un numero :
Secondo punto della finestra:
Numero da sommare o sottrarre (0): 3.29
Command: q2l
Seleziona un numero :
Secondo punto della finestra:
Numero da sommare o sottrarre (0): -0.007
Lisp »Tips 'n Tricks
Ultimo Aggiornamento_Last Update: 21 Luglio 2005
|
