Soma_Áreas.lsp
;;; Início Soma_Áreas.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2002-09-03
;;; 2002-10-15
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Áreas.lsp - Aplicação para somar áreas das entidades seleccionadas
(defun C:SOMAREA (/ CMDCH LUPRC ARSTOTAL TERM TXTOTAL
CTXT GAR SSLEN TPNAM ENTGT ENTTPO
ARTPNAM ARSTOTAL TXSTOTAL TEXTST TEXTSZ ENTST
STHIGT OSMD PTINS GTXTF TXTNOV ENTNAM
ENTGTB TXTOLD
)
(command "_.undo" "begin")
(setq CMDCH (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq DMZN (getvar "dimzin"))
(setvar "dimzin" 0)
(setq LUPRC (getvar "luprec")
ARSTOTAL 0.0
TERM 0
)
(MAREA)
(while (/= TERM nil)
(progn
(MAREA)
)
)
(setq TXTOTAL (rtos ARSTOTAL 2 LUPRC))
(initget "Criar Substituir ")
(setq CTXT
(getkword
"»» [C] Criar texto novo / [S] Substituir texto existente / [Enter] Terminar:"
)
)
(if (= CTXT "Criar")
(COLRESLC)
)
(if (= CTXT "Substituir")
(COLRESLS)
)
(setvar "dimzin" DMZN)
(setvar "cmdecho" CMDCH)
(command "_.undo" "end")
(princ "\n»» Total = ")
(princ TXTOTAL)
(terpri)
)
;;;
;;;
;;;
(defun MAREA ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GAR (ssget))
(if GAR
(progn
(setq SSLEN (sslength GAR))
(while (> SSLEN 0)
(setq TPNAM (ssname GAR (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (or (equal ENTTPO "REGION")
(equal ENTTPO "3DSOLID")
(equal ENTTPO "POLYLINE")
(equal ENTTPO "LWPOLYLINE")
(equal ENTTPO "CIRCLE")
(equal ENTTPO "ARC")
(equal ENTTPO "SPLINE")
(equal ENTTPO "ELLIPSE")
)
(progn
(command "_.area" "o" TPNAM)
(setq ARTPNAM (getvar "AREA")
ARSTOTAL (+ ARTPNAM ARSTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos ARSTOTAL 2 LUPRC))
(princ "\n»» Sub Total = ")
(princ TXSTOTAL)
(terpri)
(initget "Adicionar")
(setq TERM
(getkword
"»» [A] Adicionar outras entidades / [Enter] Terminar selecção:"
)
)
)
;;;
;;;
;;;
(defun COLRESLC ()
(setq TEXTST (getvar "TEXTSTYLE")
TEXTSZ (getvar "TEXTSIZE")
ENTST (tblsearch "style" TEXTST)
STHIGT (cdr (assoc 40 ENTST))
OSMD (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(princ
"\n»» Seleccione ponto de inserção do texto:"
)
(setq PTINS (getpoint))
(setvar "OSMODE" OSMD)
(if (> STHIGT 0.0)
(command "_.text" "j" "mr" PTINS 00.00 TXSTOTAL)
)
(if (= STHIGT 0.0)
(command "_.text" "j" "mr" PTINS TEXTSZ 00.00 TXSTOTAL)
)
)
;;;
;;;
;;;
(defun COLRESLS ()
(setq TEXTST (getvar "TEXTSTYLE")
TEXTSZ (getvar "TEXTSIZE")
ENTST (tblsearch "style" TEXTST)
STHIGT (cdr (assoc 40 ENTST))
OSMD (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(princ
"\n»» Seleccione texto a substituir:"
)
(setvar "OSMODE" OSMD)
(setq GTXTF (entsel)
TXTNOV (cons 1 TXSTOTAL)
ENTNAM (car GTXTF)
ENTGTB (entget ENTNAM)
TXTOLD (assoc 1 ENTGTB)
)
(entmod (subst TXTNOV TXTOLD ENTGTB))
(entupd ENTNAM)
)
(princ "\n»» Inicie aplicação digitando SOMAREA \n")
;;; Fim Soma_Áreas.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2002-09-03
;;; 2002-10-15
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Áreas.lsp - Aplicação para somar áreas das entidades seleccionadas
(defun C:SOMAREA (/ CMDCH LUPRC ARSTOTAL TERM TXTOTAL
CTXT GAR SSLEN TPNAM ENTGT ENTTPO
ARTPNAM ARSTOTAL TXSTOTAL TEXTST TEXTSZ ENTST
STHIGT OSMD PTINS GTXTF TXTNOV ENTNAM
ENTGTB TXTOLD
)
(command "_.undo" "begin")
(setq CMDCH (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq DMZN (getvar "dimzin"))
(setvar "dimzin" 0)
(setq LUPRC (getvar "luprec")
ARSTOTAL 0.0
TERM 0
)
(MAREA)
(while (/= TERM nil)
(progn
(MAREA)
)
)
(setq TXTOTAL (rtos ARSTOTAL 2 LUPRC))
(initget "Criar Substituir ")
(setq CTXT
(getkword
"»» [C] Criar texto novo / [S] Substituir texto existente / [Enter] Terminar:"
)
)
(if (= CTXT "Criar")
(COLRESLC)
)
(if (= CTXT "Substituir")
(COLRESLS)
)
(setvar "dimzin" DMZN)
(setvar "cmdecho" CMDCH)
(command "_.undo" "end")
(princ "\n»» Total = ")
(princ TXTOTAL)
(terpri)
)
;;;
;;;
;;;
(defun MAREA ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GAR (ssget))
(if GAR
(progn
(setq SSLEN (sslength GAR))
(while (> SSLEN 0)
(setq TPNAM (ssname GAR (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (or (equal ENTTPO "REGION")
(equal ENTTPO "3DSOLID")
(equal ENTTPO "POLYLINE")
(equal ENTTPO "LWPOLYLINE")
(equal ENTTPO "CIRCLE")
(equal ENTTPO "ARC")
(equal ENTTPO "SPLINE")
(equal ENTTPO "ELLIPSE")
)
(progn
(command "_.area" "o" TPNAM)
(setq ARTPNAM (getvar "AREA")
ARSTOTAL (+ ARTPNAM ARSTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos ARSTOTAL 2 LUPRC))
(princ "\n»» Sub Total = ")
(princ TXSTOTAL)
(terpri)
(initget "Adicionar")
(setq TERM
(getkword
"»» [A] Adicionar outras entidades / [Enter] Terminar selecção:"
)
)
)
;;;
;;;
;;;
(defun COLRESLC ()
(setq TEXTST (getvar "TEXTSTYLE")
TEXTSZ (getvar "TEXTSIZE")
ENTST (tblsearch "style" TEXTST)
STHIGT (cdr (assoc 40 ENTST))
OSMD (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(princ
"\n»» Seleccione ponto de inserção do texto:"
)
(setq PTINS (getpoint))
(setvar "OSMODE" OSMD)
(if (> STHIGT 0.0)
(command "_.text" "j" "mr" PTINS 00.00 TXSTOTAL)
)
(if (= STHIGT 0.0)
(command "_.text" "j" "mr" PTINS TEXTSZ 00.00 TXSTOTAL)
)
)
;;;
;;;
;;;
(defun COLRESLS ()
(setq TEXTST (getvar "TEXTSTYLE")
TEXTSZ (getvar "TEXTSIZE")
ENTST (tblsearch "style" TEXTST)
STHIGT (cdr (assoc 40 ENTST))
OSMD (getvar "OSMODE")
)
(setvar "OSMODE" 0)
(princ
"\n»» Seleccione texto a substituir:"
)
(setvar "OSMODE" OSMD)
(setq GTXTF (entsel)
TXTNOV (cons 1 TXSTOTAL)
ENTNAM (car GTXTF)
ENTGTB (entget ENTNAM)
TXTOLD (assoc 1 ENTGTB)
)
(entmod (subst TXTNOV TXTOLD ENTGTB))
(entupd ENTNAM)
)
(princ "\n»» Inicie aplicação digitando SOMAREA \n")
;;; Fim Soma_Áreas.lsp
