Newsgroup: it.discussioni.geometri
Titolo: AutoCAD: LISP per leggere file .EMP di PREGEO 8

Ho appena scritto per un amico un LISP per caricare, direttamente in
AutoCAD, i punti ed i contorni da un file .emp generato da PREGEO 8. Il
programma considera solamente le righe 8 dei punti e le righe 7 dei
contorni. I punti, i testi e le linee verranno creati rispettivamente sui
layers 00_PUNTI, 00_CODICI, 00_CONTORNI.
Se a qualcuno interessa lo può scaricare qui:
http://www.sepram.com/DEMO/LSP/Carica%20EMP.LSP
Altri LISP free li potete vedere qui:
http://www.sepram.com/applicazioni_lisp.htm
Ciao Claudio
-- 
--


Ottimo....Grazieeeeee 

 AutoCAD, i punti ed i contorni da un file .emp generato da PREGEO 8.
OTTIMO.
Sarebbe interressante aggiungere anche il file raster PNG ora.
Tempo fa avevo già fatto un lispino apposito ma non sempre funziona. se
qualcuno volesse (sepram) volesse integrare e aggiustere il mio lisp sarebbe
bello.
;;;;;;;;;;;;;;;;;;;;;,BOF;;;;;;;;;;;;;;;;;;;;;;;;,
(DEFUN C:EMP ()
  (setq oldANGBASE (getvar "ANGBASE"))
  (setq oldANGDIR (getvar "ANGDIR"))
  (setq oldAUNITS (getvar "AUNITS"))
  (setq oldAUPREC (getvar "AUPREC"))
  (setq oldCLAYER (getvar "CLAYER"))
  (Setvar "ANGBASE" 0)
  (Setvar "ANGDIR" 0)
  (Setvar "AUNITS" 3)
  (Setvar "AUPREC" 4)
  (COMMAND "_layer" "_M" "MAPPA_RASTER" "")
  (SETQ FILENAME (GETFILED "SCEGLI LA CARTELLA DELLE IMMAGINI DA IMPORTARE"
"C:/PREGEO/ESTRATTI/" "EMP" 0))
  (SETQ FILENAME (STRCAT FILENAME "*.EMP"))
  (SETQ FILENAME (SUBSTR FILENAME 1 (- (STRLEN FILENAME) 5)))
  (SETQ LINEA "DIVERSODANIL")
  (SETQ FILEAPERTO (OPEN FILENAME "r"))
  (WHILE (/= LINEA NIL)
    (SETQ ULTIMA LINEA)
    (SETQ LINEA (READ-LINE FILEAPERTO))
    );WHILE
  ;(SETQ Ncar "DIVERSODANIL")
  (setq a 2)
  (setq lista_mink (list' 2))
  (REPEAT (- (STRLEN ULTIMA) 2)
    (setq a (1+ a))
    (setq caratt (substr ultima a 1))
    (if (= caratt "|")
      (progn
 (setq lista_mink (append lista_mink (list a)))
 );progn
      );if
    );repeat
  (setq Y_imm (substr ultima (1+ (nth 1 lista_mink)) (-(nth 2 lista_mink)
(nth 1 lista_mink) 1)))
  (setq X_imm (substr ultima (1+ (nth 2 lista_mink)) (-(nth 3 lista_mink)
(nth 2 lista_mink) 1)))
  (setq S_imm (substr ultima (1+ (nth 3 lista_mink)) (-(nth 4 lista_mink)
(nth 3 lista_mink) 1)))
  (setq R_imm (substr ultima (1+ (nth 6 lista_mink)) (-(nth 7 lista_mink)
(nth 6 lista_mink) 1)))
  (setq file_imm (strcat (substr filename 1 (-(strlen filename) 4)) ".PNG"))
;(SETQ PT1 (GETPOINT "PUNTO D'INIZIO:"))
  (COMMAND "_IMAGE" "_A" FILE_imm (list (atof X_imm) (atof Y_imm)) 1 0)
  (setq ult (entlast))
  (setq dati_immagine (entget ult))
  (setq dati_pixel (assoc 13 dati_immagine))
  (setq pixel_X (car (cdr dati_pixel)))
  (setq pixel_Y (car (cdr (cdr dati_pixel))))
  (setq delta_Y (* (atof S_imm) pixel_Y))
  (setq Y_nuova (- (atof Y_imm) delta_Y))
  (setq lista_XYZ (list (atof X_imm) Y_nuova (atof "0.0")))
  ;(subst (cons 10 lista_XYZ) (assoc 10 dati_immagine) dati_immagine)
  (command "_SCALE" ult "" (list (atof X_imm) (atof Y_imm)) (* (atof S_imm)
Pixel_X))
  ;(entmod dati_immagine)
  (command "_MOVE" ult "" (cdr (assoc 10 dati_immagine)) lista_XYZ)
  (command "_ROTATE" ult "" lista_XYZ R_imm)
  (command "_DRAWORDER" ult "" "_B")
  (Setvar "ANGBASE" oldANGBASE)
  (Setvar "ANGDIR" oldANGDIR)
  (Setvar "AUNITS" oldAUNITS)
  (Setvar "AUPREC" oldAUPREC)
  (Setvar "CLAYER" oldCLAYER)
)
;;;;;;;;;;;;;;;,EOF;;;;;;;;;;;;;;;;;;;;;;
-- 
Massimo Ghio
per rispondere metti nove al posto dell'otto