;
; Versione per AUTOCAD 12 o Superiore I T A L I A N O / I N G L E S E
;
; Copyright (C)2003 by Claudio Rivoira
;
; _________________________________________________________________
; | |
; | CREA UNA FRECCIA: |
; | |
; | - Inserire 1° punto (Vertice della freccia) |
; | - Inserire 2° punto (Determina dimens. freccia) |
; | - Inserire 3° punto (determina la rotazione dellla freccia) |
; | - Inserire altri punti (se si desidera proseguire la "coda") |
; | |
; ŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻŻ
;
;
;---------------------------------
; Input Variabili ambiente
;---------------------------------
(defun MODES (a)
(setq mlst '())
(repeat (length a)
(setq mlst (append mlst (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
)
;-----------------------------------
; Ripristina variabili ambiente
;-----------------------------------
(defun MODER ()
(repeat (length mlst)
(setvar (caar mlst) (cadar mlst))
(setq mlst (cdr mlst))
)
)
; ----------------------------------
; Error handler (gestione errore)
; ----------------------------------
(defun b_err (st)
(moder) ; Ripristina variabili memorizzate
(setq *error* olderr) ; Restore old *error* handler
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
;;;; Inserire qui altre variabili di sistema o comandi da eseguire prima dell'uscita
(princ) ; Esce senza nil
)
;----------------------------
; Input Dati
;----------------------------
(defun INDATI ()
;
(graphscr)
(setvar "highlight" 1)
(setvar "pickstyle" 1) ; Impostando a 1 questa variabile, i gruppi vengono selezionati
;
(modes '("OSMODE" "LIMCHECK" "CMDECHO"))
(setvar "osmode" 0) ; Azzera osnap
(setvar "limcheck" 0) (setvar "cmdecho" 0)
;
(setq stiletxt (getvar "textstyle")) ; Memorizza lo stile di testo corrente
(command "_style" "messaggi" "arial black" 0 0.7 0 "n" "n"); Crea un nuovo stile e lo rende corrente
(setvar "TEXTSTYLE" stiletxt) ; Riporta allo stile di testo normale
;
(setq sel (ssadd)) ; Crea un gruppo di selez. senza entita'
;
(while (= pt1 nil) ; Questo while serve per non avere pt1 = nil
(xx:messaggio "Vertice della freccia:" 1) ; Inserisce messaggio su schermo grafico
(setq pt1 (getpoint "\nVertice della freccia: "))
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
)
;
(while (= pt2 nil) ; Questo while serve per non avere pt2 = nil
(xx:messaggio "2° punto:" 2) ; Inserisce messaggio su schermo grafico
(setq pt2 (getpoint pt1 "\n2° punto: "))
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
)
;
(xx:messaggio "n3° punto: Direzione o <Invio>:" 3); Inserisce messaggio su schermo grafico
(prompt "\n3° punto: Direzione della freccia")
(setq pt3 (getpoint pt2 "\n(Invio = usa la direzione del 2° punto) : "))
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
;
(if (= pt3 nil) ; Se pt3 è nullo ...
(progn
(setq pt3 pt2) ; ... Pone pt3 = a pt2 ...
(while (= pt4 nil) ; Questo while serve per non avere pt4 = nil
(xx:messaggio "Altro punto:" 6) ; Inserisce messaggio su schermo grafico
(setq pt4 (getpoint pt3 "\nAltro punto: ")); Richiede un altro punto
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
)
)
)
;
(setq lfre (distance pt1 pt2)) ; Lunghezza della freccia
(setq hfre (/ lfre 2)) ; Altezza della freccia = 1/2 della lunghezza
(setq pt2 (polar pt1 (angle pt1 pt3) lfre)) ; Ricalcola la posizione del pt2
;
(if pt4 ; Se il punto pt4 esiste ...
(progn
(command "_pline" pt1 "_w" 0 hfre pt2 "_w" 0 0 pt4 ""); Disegna la freccia (polilinea con largh. variabile)
(setq ptvec pt4) ; Pone PTVECchio = pt4
)
(progn
(command "_pline" pt1 "_w" 0 hfre pt2 "_w" 0 0 pt3 ""); Disegna la freccia (polilinea con largh. variabile)
(setq ptvec pt3) ; Pone PTVECchio = pt3
)
)
;
(setq sel (ssadd (entlast) sel)) ; Aggiunge alla selez. l'ultima entita' creata (la polilinea)
;
(setq loop T) ; Inizializza il flag (per entrare nel loop)
(while loop
(xx:messaggio "Altro punto (Invio=fine):" 7); Inserisce messaggio su schermo grafico
(setq ptnew (getpoint ptvec "\nAltro punto (Invio=fine): "))
(entdel msgscr) ; Cancella il messaggio di testo dallo schermo grafico
(if ptnew ; Se ptnew esiste (diverso da nil) ...
(command "_line" ptvec ptnew "") ; Traccia una linea ...
(setq loop nil) ; ... altrimenti annulla il flag (per uscire da loop)
)
(setq sel (ssadd (entlast) sel)) ; Aggiunge alla selez. l'ultima entita' creata (la linea)
(setq ptvec ptnew) ; Aggiorna la posizione del punto vecchio
)
;
(command "_pedit" sel "_J" sel "" "") ; Unisce tutte le linee alla freccia
;
)
;;;;
;;;;
;;;;
;;;;----------------------------------------
;;;; SCRIVE UN MESSAGGIO SU SCHERMO
;;;;----------------------------------------
;;;;
;;;; Questa sub. può essere utilizzata per creare dei messaggi
;;;; sullo schermo durante l'utilizzo del programma.
;;;; I messaggi sono dei testi posizionati a centro schermo e con
;;;; una dim. (H testo) che si adegua allo zoom corrente.
;;;; Dopo aver scritto il messaggio, la sub. memorizza il testo nel
;;;; set di selezione MSGSCR in modo da poterlo
;;;; cancellare successivamente.
;;;;
;;;; Purtroppo l'utilizzo di un'entità 'testo' impone di non poter
;;;; utilizzare il bit 64 di osmode (Punto di inserimento) che
;;;; potrebbe 'forzare' l'osnap sul punto di inserimento del testo
;;;; anzichè sul punto desiderato.
;;;; Occorre quindi utilizzare questa subrutine senza osnap o comunque
;;;; con un valore in cui non ci sia il punto di inserimento.
;;;;
;;;; Dati in input:
;;;; txt = Testo da inserire: è una semplice stringa (non deve essere preceduta da '\n')
;;;; colmsg = Colore del testo : un numero dall'1 al 255 che identifica il colore
;;;;
;;;; Dati in output:
;;;; msgscr = Set di selezione con il quale è possibile cancellare il testo in qualunque momento.
;;;;
;;;;
;
(defun xx:messaggio (txt colmsg)
;
(setvar "TEXTSTYLE" "messaggi") ; Imposta lo stile di testo per i messaggi (creato nella sub. INDATI)
;
(setq posiz
(list
(car (getvar "viewctr")) ; Asse x della coord. del centro dello schermo corrente
(+
(cadr (getvar "viewctr")) ; Asse y della coord. del centro dello schermo corrente
(* (/ (getvar "viewsize") 10) -4); Sposta verso la parte bassa dello schermo
)
)
)
; Viene scritto il testo sullo schermo con un H testo pari a 1/15 della dimensione dello zoom corrente
(command "_text" "_j" "_mc" posiz (/ (getvar "viewsize") 15) 0 txt)
(setq msgscr (entlast)) ; Memor. il testo appena creato: sara' possibile cancellarlo facilmente
(command "_change" msgscr "" "_p" "_c" colmsg ""); Cambia il colore al testo del messaggio
(setvar "TEXTSTYLE" stiletxt) ; Riporta allo stile di testo normale
)
;;;;
;
;
;--------------------------------------------------
; P R O G R A M M A P R I N C I P A L E
;--------------------------------------------------
(defun C:FRECCIA (/
a mlst st ; In MODES e MODER per salvare e riprist. variabili
olderr ; Gestione errori
pt1 pt2 pt3 pt4 ; Punti della freccia
lfre hfre ; lunghezza e altezza freccia
sel ; Set di selezione (per creare un'unica polilinea)
ptvec ptnew ; Punto vecchio e punto nuovo (per creare le linee)
loop ; Flag per entrare nel while
)
;
(setq olderr *error* *error* b_err) ; Richiama gestore errori
;
(indati) ; Input dei dati
;
(moder) ; Ripristina variabili iniziali
;
(setq olderr *error*) ; Ripristina in caso di errore
(princ) ; Esce senza nil
)