;;; Início Reg_Coor_Pontos_CSV.lsp ;;; VER 1.1 ;;; J.A. ;;; www.jorgeanjos.com ;;; VER 1.0 - 1995-12-05 ;;; VER 1.1 - 2009-01-14 ;;; Início Reg_Coor_Pontos_CSV.lsp - Aplicação para registar coordenadas de pontos (points) em ficheiro de texto tipo CSV (defun c:RCPV (/ ACMDCH ADZIN VALLPRC UNPRC SSET NMFILE FILETX VIRG SSLEN TEMPS CORDX CORDY CORDZ TXCORDX TXCORDY TXCORDZ) (defun SETVRS () (setq ACMDCH (getvar "cmdecho")) (setvar "cmdecho" 0) (setq ADZIN (getvar "dimzin")) (setvar "dimzin" 0) (setq VALLPRC (getvar "luprec")) (command "_.undo" "begin") (setq AERR *error*) ) (defun RESETVRS () (setq *error* AERR) (setvar "dimzin" ADZIN) (command "_.undo" "end") (setvar "cmdecho" ACMDCH) ) (SETVRS) (princ "\n»» How many decimal places? (0/8) ")(princ "<") (princ VALLPRC)(princ ">") (setq UNPRC (getint)) (princ "\n»» Select the Points:\n") (setq SSET (ssget '(( 0 . "POINT")))) (if SSET (progn (if (= UNPRC nil) (setq UNPRC VALLPRC)) (setq NMFILE (getfiled "Name for the CSV File" "" "csv" 1) FILETX (open NMFILE "a") VIRG "," SSLEN (sslength SSET)) (while (> SSLEN 0) (setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN))) CORDX (nth 1 (assoc 10 (entget TEMPS))) CORDY (nth 2 (assoc 10 (entget TEMPS))) CORDZ (nth 3 (assoc 10 (entget TEMPS))) TXCORDX (rtos CORDX 2 UNPRC) TXCORDY (rtos CORDY 2 UNPRC) TXCORDZ (rtos CORDZ 2 UNPRC)) (write-line (strcat ""TXCORDX""VIRG""TXCORDY""VIRG""TXCORDZ"") FILETX) ) (close FILETX) ) (princ "\n»» None Point Selected... \n") ) (RESETVRS) ) ;;; ;;; ;;; (defun *error* (msg) (setq *error* AERR) (setvar "cmdecho" ACMDCH) (setvar "dimzin" ADZIN) (command "_.undo" "end") (princ (strcat "»» Aplication Stoped By an Error: " msg)) ) (terpri) (princ "\n»» Start the aplication Writing RCPV \n") ;;; Fim Reg_Coor_Pontos_CSV.lsp