cg-Cad

Lisp »Tips 'n Tricks »Cerca e zooma su testo

(defun c:ctxt ( / str s1 n K ent ltxt txt p1 p2 p3 alt ncar)
 (setq str (getstring "\n Parola da cercare: " 40))
 (setq str (strcase str))
 (setq s1  (ssget "X" '((0 . "TEXT"))))
 (setq n (sslength s1))
 (setq K 0)
 (repeat n
  (setq ent (entget (ssname s1 K)))
  (setq ltxt (assoc 1 ent))
  (setq txt (strcase (cdr ltxt)) )
  (if (= txt str)
   (progn
    (setq alt (cdr (assoc 40 ent))) ; altezza testo
    (setq ncar (strlen txt))        ; numero caratteri
    (setq p1 (cdr (assoc 10 ent)))  ; punto inserimento testo
    (setq p2 (polar p1 (* pi (/ 135.0 180.0))(* alt ncar)))
    (setq p3 (polar p1 (* pi (/ 315.0 180.0))(* alt ncar)))
    (command "_zoom" "_w" p2 p3)
   )
  )
  (setq K (+ K 1))
 )
 (princ)
);;;eof

Lisp »Tips 'n Tricks

Ultimo Aggiornamento_Last Update: 28 Febbraio 2008