;;; Início Reg_Coor_Pontos_CSV.lsp
;;; VER 1.1
;;; J.A.
;;; www.cadtom.com
;;; VER 1.0 - 1995-12-05
;;; VER 1.1 - 2009-01-14
;;; VER 1.1 - 2009-01-15
;;; 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»» Quantas casas decimais? (0/8) ")
(princ "<")
(princ VALLPRC)
(princ ">")
(setq UNPRC (getint))
(princ "\n»» Seleccione pontos:\n")
(setq SSET (ssget '((0 . "POINT"))))
(if SSET
(progn
(if (= UNPRC nil)
(setq UNPRC VALLPRC)
)
(setq NMFILE (getfiled "Ficheiro para registo das coordenadas"
""
"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»» Nenhum ponto seleccionado... \n")
)
(RESETVRS)
)
;;;
;;;
;;;
(defun *error* (msg)
(setq *error* AERR)
(if FILETX
(close FILETX)
)
(setvar "cmdecho" ACMDCH)
(setvar "dimzin" ADZIN)
(command "_.undo" "end")
(princ (strcat "»» Aplicação interrompida com erro: " msg))
)
(terpri)
(princ "\n»» Inicie aplicação digitando RCPV \n")
