;;; Início Reg_Coor_2D_Cont_Textos_Csv.lsp
;;; VER 1.1
;;; J.A.
;;; www.cadtom.com
;;; VER 1.0 - 1995-12-05
;;; VER 1.1 - 2009-01-14
;;; Início Reg_Coor_2D_Cont_Textos_Csv.lsp - Aplicação para registar coordenadas 2D (insert) de textos (pontos topográficos)
;;; e o conteúdo em ficheiro de texto tipo CSV
(defun c:RCCPV (/ ACMDCH ADZIN VALLPRC UNPRC SSET
NMFILE FILETX VIRG SSLEN TEMPS TEXTIT
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 para a informação numérica? (0/8) "
)
(princ "<")
(princ VALLPRC)
(princ ">")
(setq UNPRC (getint))
(princ "\n»» Seleccione textos:\n")
(setq SSET (ssget '((0 . "TEXT"))))
(if SSET
(progn
(if (= UNPRC nil)
(setq UNPRC VALLPRC)
)
(setq NMFILE (getfiled
"Ficheiro para registo das coordenadas e conteúdo do texto"
""
"csv"
1
)
FILETX (open NMFILE "a")
VIRG ","
SSLEN (sslength SSET)
)
(while (> SSLEN 0)
(setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN)))
TEXTIT (cdr (assoc 1 (entget TEMPS)))
CORDX (nth 1 (assoc 10 (entget TEMPS)))
CORDY (nth 2 (assoc 10 (entget TEMPS)))
TXCORDX (rtos CORDX 2 UNPRC)
TXCORDY (rtos CORDY 2 UNPRC)
)
(write-line
(strcat "" TXCORDX "" VIRG "" TXCORDY "" VIRG "" TEXTIT "")
FILETX
)
)
(close FILETX)
)
(princ "\n»» Nenhum texto 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 RCCPV \n")
