cg-Cad

Lisp »Tips 'n Tricks »Abloc.lsp

ABLOC.LPS

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