Soma_Volumes.lsp
;;; Início Soma_Volumes.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Volumes.lsp - Aplicação para somar volumes das entidades (3DSOLIDS) seleccionadas
(defun C:SOMAVOL (/ CMDCH LUPRC VOLTOTAL TERM AOBJ
ADOC AMODL TXTOTAL CTXT GVOL SSLEN
TPNAM ENTGT ENTTPO 3DSOLD VOLUM 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")
VOLTOTAL 0.0
TERM 0
)
(vl-load-com)
(setq AOBJ (vlax-get-acad-object))
(setq ADOC (vla-get-activedocument AOBJ))
(setq AMODL (vla-get-modelspace ADOC))
(MVOLUM)
(while (/= TERM nil)
(progn
(MVOLUM)
)
)
(setq TXTOTAL (rtos VOLTOTAL 2 LUPRC))
(terpri)
(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")
(terpri)
(princ "\n»» Total = ")
(princ TXTOTAL)
(terpri)
)
;;;
;;;
;;;
(defun MVOLUM ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GVOL (ssget))
(if GVOL
(progn
(setq SSLEN (sslength GVOL))
(while (> SSLEN 0)
(setq TPNAM (ssname GVOL (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (equal ENTTPO "3DSOLID")
(progn
(setq 3DSOLD (vlax-ename->vla-object TPNAM)
VOLUM (vlax-get-property 3DSOLD 'volume)
VOLTOTAL (+ VOLUM VOLTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos VOLTOTAL 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 SOMAVOL \n")
;;; Fim Soma_Volumes.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Volumes.lsp - Aplicação para somar volumes das entidades (3DSOLIDS) seleccionadas
(defun C:SOMAVOL (/ CMDCH LUPRC VOLTOTAL TERM AOBJ
ADOC AMODL TXTOTAL CTXT GVOL SSLEN
TPNAM ENTGT ENTTPO 3DSOLD VOLUM 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")
VOLTOTAL 0.0
TERM 0
)
(vl-load-com)
(setq AOBJ (vlax-get-acad-object))
(setq ADOC (vla-get-activedocument AOBJ))
(setq AMODL (vla-get-modelspace ADOC))
(MVOLUM)
(while (/= TERM nil)
(progn
(MVOLUM)
)
)
(setq TXTOTAL (rtos VOLTOTAL 2 LUPRC))
(terpri)
(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")
(terpri)
(princ "\n»» Total = ")
(princ TXTOTAL)
(terpri)
)
;;;
;;;
;;;
(defun MVOLUM ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GVOL (ssget))
(if GVOL
(progn
(setq SSLEN (sslength GVOL))
(while (> SSLEN 0)
(setq TPNAM (ssname GVOL (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (equal ENTTPO "3DSOLID")
(progn
(setq 3DSOLD (vlax-ename->vla-object TPNAM)
VOLUM (vlax-get-property 3DSOLD 'volume)
VOLTOTAL (+ VOLUM VOLTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos VOLTOTAL 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 SOMAVOL \n")
;;; Fim Soma_Volumes.lsp
