Lisp »Tips 'n Tricks
»Abloc.lsp
Modifica del comando DIVIDE, copia su un percorso il blocco selezionato ma chiede la "distanza tra blocchi" e non il numero dei blocchi poi calcola quanti blocchi inserire.
Autore: Michele Ingenuo - Sito Web: 3eye
;Abloc.lsp (C) 2003 by Michele Ingenuo Ingoenius
;
;lisp blocchi duplica i blocchi lungo un percorso
;immettendo la distanza tra blocchi
;trasforma in polylinea il percorso e calcola il numero di
;divisioni da fare sul percorso
(defun C:ABLOC ()
(setq nome (car (entsel "\nSeleziona il percorso")))
(setq DTIPO (entget nome))
(setq TIPO (cdr (assoc 0 DTIPO)));determina cos'้ il tipo di oggetto
(cond
((= TIPO "ARC") ;se ้ un arco
;se non ้ un polilinea converte e poi procede
(command "_pedit" nome "" "" "" )
(setq nomeD (entget (entlast))) ;ultimo oggetto creato
(setq nome (cdr (assoc -1 nomeD))) ;nuovo nome entitเ
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
;estrae tutte le informazioni del blocco
(setq DatiB (entget BLOCCO))
;recupera il nome del blocco selezionato
(setq NBLOC (cdr (assoc 2 DatiB)))
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome)) ;dati polilinea
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
;calcola il numero delle copie da fare
(setq N (+ 1 (fix (/ lung SPAZIO))))
; (command "_divide" nome "B" NBLOC "o" N "")
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 1
((= TIPO "CIRCLE") ;se ้ un cerchio
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
(setq DatiB (entget BLOCCO)) ;estrae tutte le informazioni del blocco
(setq NBLOC (cdr (assoc 2 DatiB))) ;recupera il nome del blocco selezionato
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome)) ;dati polilinea
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
(setq N (+ 1 (fix (/ lung SPAZIO)))) ;calcola il numero delle copie da fare
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 2
((= TIPO "ELLIPSE") ;se ้ un'ellisse
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
(setq DatiB (entget BLOCCO))
(setq NBLOC (cdr (assoc 2 DatiB)))
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome))
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
(setq N (+ 1 (fix (/ lung SPAZIO))))
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 3
((= TIPO "LWPOLYLINE") ;se ้ una polilinea
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
(setq DatiB (entget BLOCCO))
(setq NBLOC (cdr (assoc 2 DatiB)))
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome))
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
(setq N (+ 1 (fix (/ lung SPAZIO))))
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 4
((= TIPO "SPLINE") ;se ้ una spline
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
(setq DatiB (entget BLOCCO))
(setq NBLOC (cdr (assoc 2 DatiB)))
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome))
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
(setq N (+ 1 (fix (/ lung SPAZIO))))
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 5
((= TIPO "LINE") ;se ้ una line
(command "_pedit" nome "" "" "" ) ;se non ้ un polilinea converte e poi procede
(setq nomeD (entget (entlast))) ;dati ultima selezione
(setq nome (cdr (assoc -1 nomeD))) ;nuovo nome entitเ
(setq BLOCCO (car (entsel "\nSeleziona 1 blocco ")))
(setq DatiB (entget BLOCCO)) ;estrae tutte le informazioni del blocco
(setq NBLOC (cdr (assoc 2 DatiB))) ;recupera il nome del blocco selezionato
(setq SPAZIO (getreal "\nSpazio tra copie\n"))
(setq dati (entget nome)) ;dati polilinea
(command "_area" "_object" nome)
(setq lung (getvar "perimeter"))
(setq N (+ 1 (fix (/ lung SPAZIO)))) ;calcola il numero delle copie da fare
(command "_divide" nome "B" NBLOC "" N "")
);fine cond 6
(t nil)
);fine delle cond
);fine defun
|
Lisp »Tips 'n Tricks
|