Conv_Pontos_Texto.lsp

;;; Início Conv_Pontos_Texto.lsp
;;; Ver 1.1

;;; J.A.
;;; www.cadtom.com

;;; Ver 1.0 - 2006-11-15
;;; Ver 1.1 - 2007-01-29

;;; Conv_Pontos_Texto.lsp - Aplicação para converter a coordenada Z de pontos (topográficos) em textos

(defun C:CPT (/	       AOSMD	ADECH	 ADZIN	  VALLPRC  UNPRC
	      TEXTST   ENTST	STHIGT	 TEXTSZ	  TEMPS	   CORDX
	      CORDY    CORDZ	TXCORDZ	 PONTO
	     )


  (command "_.undo" "begin")
  (setq AERR *error*)
  (setq	AOSMD (getvar "osmode")
	ADECH (getvar "cmdecho")
	ADZIN (getvar "dimzin")
  )
  (setvar "cmdecho" 0)
  (setvar "dimzin" 0)
  (setq VALLPRC (getvar "luprec"))

  (princ "\n»» Seleccione pontos:\n")
  (setq SSET (ssget '((0 . "POINT"))))
  (setvar "osmode" 0)
  (if SSET
    (progn
      (terpri)
      (princ "\n»» Quantas casas decimais? (0/8) ")
      (princ "<")
      (princ VALLPRC)
      (princ ">")
      (setq UNPRC (getint))
      (if (= UNPRC nil)
	(setq UNPRC VALLPRC)
      )
      (setq TEXTST (getvar "TEXTSTYLE"))
      (setq ENTST (tblsearch "style" TEXTST))
      (setq STHIGT (cdr (assoc 40 ENTST)))
      (PRINC STHIGT)
      (setq OSM (getvar "osmode"))
      (if (= STHIGT 0.0)
	(progn
	  (princ "\n»» Qual a altura do texto? ")
	  (setq TEXTSZ (getdist))
	)
      )

      (setq SSLEN (sslength SSET))
      (while (> SSLEN 0)
	(setq TEMPS (ssname SSET (setq SSLEN (1- SSLEN))))
	(setq CORDX (nth 1 (assoc 10 (entget TEMPS))))
	(setq CORDY (nth 2 (assoc 10 (entget TEMPS))))
	(setq CORDZ (nth 3 (assoc 10 (entget TEMPS))))
	(setq TXCORDZ (rtos CORDZ 2 UNPRC))
	(setq PONTO (list CORDX CORDY 0.0))
	(if (> STHIGT 0.0)
	  (command "text" PONTO 00.00 TXCORDZ)
	  (command "text" PONTO TEXTSZ 00.00 TXCORDZ)
	)
      )
    )
    (princ "\n»» Nenhum ponto seleccionado!")
  )
  (setvar "osmode" AOSMD)
  (setvar "dimzin" ADZIN)
  (command "_.undo" "end")
)

;;;
;;;
;;;

(defun *error* (msg)

  (setq *error* AERR)
  (setvar "cmdecho" ADECH)
  (setvar "osmode" AOSMD)
  (setvar "dimzin" ADZIN)
  (command "_.undo" "end")
  (princ (strcat "»» Aplicação interrompida com erro: " msg))
)

(terpri)
(princ "\n»» Inicie aplicação digitando CPT \n")

;;; Fim Conv_Pontos_Texto.lsp


 
Top