;;; Início Reg_Coor_Pontos_TXT.lsp
;;; VER 1.1

;;; J.A.
;;; www.jorgeanjos.com

;;; VER 1.0 - 1995-12-05
;;; VER 1.1 - 2009-01-14
;;; VER 1.2 - 2009-01-15

;;; Início Reg_Coor_Pontos_Txt.lsp - Aplicação para registar coordenadas de pontos (points) em ficheiro de texto tipo TXT

(defun c:RCP (/	       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"
			     ""
			     "txt"
			     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 RCP \n")

;;; Fim Reg_Coor_Pontos_TXT.lsp