;|

  TXC2.LSP (3 Aprile 2006)
  Copyright (C) 2006 Claudio Piccini. All rights reserved
  www.cg-cad.com

  Legge dal file CERCHI.TXT coordinate X Y Z del punto,
  il diametro del cerchio e una etichetta.
  Salva come xdata XYZ, diam. e etichetta.

  Esempio di file CERCHI.TXT:
    x            y      z dia. etichetta
  706.3385   919.141108 0 10     "C"
  731.027256 856.218884 0 1      "B"
  654.002078 819.409167 0 1.5    "C"
  632.234096 919.799307 0 2      "B"
  528.417552 886.335928 0 3.5    "E"
  503.300646 812.716491 0 4      "C"

|;

(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"))  
 (setq nomeDir (getvar "dwgprefix"))
)

(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 C:TXC2 (/ olderr snapp snm orto piano nomeDir 
                 stringa lista nf1 f1
                 ed xd entX
 )
 (setq olderr *error* *error* myerror)
 (setvar "cmdecho" 0)
 (salVar)
 (if (not (tblsearch "appid" "CERCHI_TXC"))(regapp "CERCHI_TXC")) 
 (command "osnap" "_non")
 (setq nf1 (strcat nomeDir "cerchi.txt"))
 (setq f1 (open nf1 "r")) ; apre il file CERCHI.TXT
 (setq stringa " ")
 (while (/= stringa nil)
  (setq stringa (read-line f1))
  (if (/= stringa nil)
   (progn
    (setq lista (strcat "(" stringa ")"))
    (setq lista (read lista))
    (command "_circle" (list 
                        (nth 0 lista) ; X
                        (nth 1 lista) ; Y
                        (nth 2 lista) ; Z
                       )
     "_d" (nth 3 lista) ; diamentro
    )
    (setq ed (entget (entlast))) ; legge l'entita'
    (setq xd (list -3 (list "CERCHI_TXC"
                         (cons 1000 (nth 4 lista)) ; etichetta
                         (cons 1002 "{")
                         (cons 1040 (nth 0 lista)) ; X
                         (cons 1040 (nth 1 lista)) ; Y
                         (cons 1040 (nth 2 lista)) ; Z
                         (cons 1041 (nth 3 lista)) ; diametro
                         (cons 1002 "}")
                      )
             )
    )
    (setq entX (append ed (list xd))) ; aggiunge la lista xd alla lista ed
    (entmod entX) ; aggiorna l'entita' cerchio
   )
  )
 )
 (close f1)
 (ripVar)
)
;;;eof

;|

  SCCX.LSP (3 Aprile 2006)
  Copyright (C) 2006 Claudio Piccini. All rights reserved
  www.cg-cad.com
 
  Scala tutti i cerchi di una etichetta xdata

|;

(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 leggi_scala_eX ( / p1 p2 s1 nEn
                          en ed xd
                          k kk eti 
 )
 (setq p1 (getpoint "\n Seleziona le entita' con una finestra: "))
 (initget (+ 1 32))
 (setq p2 (getcorner p1 "\n Secondo punto della finestra: "))
 (setq s1 (ssget "_C" p1 p2 '((-3 ("CERCHI_TXC")))))
 (setq nEn (sslength s1))
 (setq k 0 kk 0)
 (repeat nEn
  (setq en (ssname s1 k)
        ed (entget en '("CERCHI_TXC"))
        xd (cdr (assoc -3 ed))
  )
  (setq eti (strcase (cdadar xd)))
  (if (= eti E)
   (progn
    (setq p1 (list 
              (cdr (caddr (cdr (car xd))))   ; X
              (cdr (cadddr (cdr (car xd))))  ; Y
              (cdr (cadddr (cddr (car xd)))) ; Z
             )
    )
    (command "_scale" en "" p1 scala)
    (setq kk (+ kk 1))
   )
  )
  (setq k (+ k 1))
 )
 (princ "\n Scalati ")(princ kk)
 (princ " cerchi ")(princ E)
)

(defun C:SCCX ( / olderr snapp snm orto piano 
                  E scala 
 )
 (setq olderr *error* *error* myerror)
 (setvar "cmdecho" 0)
 (salVar)
 (setq E (strcase (getstring "\n Etichetta? ")))
 (setq scala (getreal "\n Scala? "))
 (leggi_scala_eX)
 (ripVar)
)
;;;eof