cg-Cad

Lisp »Tips 'n Tricks »Traduttore »1 »2 »3 »4

Q2C (v.2)

Q2C traduce una quota numerica reale (o più quote/testi racchiusi in una finestra di selezione) in lettere e la scrive nel disegno.

Per aggiungere o sottrarre un numero prima della conversione battere il numero altrimenti premere 0 (zero).

;|

   Q2C (vers. 2) Copyright (C) 2005 by Claudio Piccini.
   All rights reserved
   www.cg-cad.com

   Traduce una quota numerica 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
 )
 (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)))
      (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 "." (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 (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:Q2C (/ 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 una quota :"))
  (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: q2c
Seleziona una quota :
Secondo punto della finestra:
Numero (0): -1.1

prima di q2c prima di q2c

dopo q2c dopo q2c



Lisp »Tips 'n Tricks

Ultimo Aggiornamento_Last Update: 29 Aprile 2005