Soma_Perímetros.lsp
;;; Início Soma_Perímetros.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2002-09-02
;;; 2002-10-14
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Perímetros.lsp - Aplicação para somar os perímetros das entidades seleccionadas
(defun C:SOMAPER (/ CMDCH LUPRC LGSTOTAL TERM TXTOTAL
CTXT GLG SSLEN TPNAM ENTGT ENTTPO
LGTPNAM LGSTOTAL 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")
LGSTOTAL 0.0
TERM 0
)
(mlen)
(while (/= TERM nil)
(progn
(mlen)
)
)
(setq TXTOTAL (rtos LGSTOTAL 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 MLEN ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GLG (ssget))
(if GLG
(progn
(setq SSLEN (sslength GLG))
(while (> SSLEN 0)
(setq TPNAM (ssname GLG (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (or (equal ENTTPO "LINE")
(equal ENTTPO "POLYLINE")
(equal ENTTPO "LWPOLYLINE")
(equal ENTTPO "CIRCLE")
(equal ENTTPO "ARC")
(equal ENTTPO "SPLINE")
(equal ENTTPO "ELLIPSE")
)
(progn
(command "_.lengthen" TPNAM "")
(setq LGTPNAM (getvar "PERIMETER")
LGSTOTAL (+ LGTPNAM LGSTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos LGSTOTAL 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 SOMAPER \n")
;;; Fim Soma_Perímetros.lsp
;;; J.A.
;;; www.cadtom.com
;;; 2002-09-02
;;; 2002-10-14
;;; 2005-02-26
;;; 2007-01-27
;;; Soma_Perímetros.lsp - Aplicação para somar os perímetros das entidades seleccionadas
(defun C:SOMAPER (/ CMDCH LUPRC LGSTOTAL TERM TXTOTAL
CTXT GLG SSLEN TPNAM ENTGT ENTTPO
LGTPNAM LGSTOTAL 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")
LGSTOTAL 0.0
TERM 0
)
(mlen)
(while (/= TERM nil)
(progn
(mlen)
)
)
(setq TXTOTAL (rtos LGSTOTAL 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 MLEN ()
(princ "\n»» Seleccione entidades a somar:\n")
(setq GLG (ssget))
(if GLG
(progn
(setq SSLEN (sslength GLG))
(while (> SSLEN 0)
(setq TPNAM (ssname GLG (setq SSLEN (1- SSLEN)))
ENTGT (entget TPNAM)
ENTTPO (cdr (assoc 0 ENTGT))
)
(if (or (equal ENTTPO "LINE")
(equal ENTTPO "POLYLINE")
(equal ENTTPO "LWPOLYLINE")
(equal ENTTPO "CIRCLE")
(equal ENTTPO "ARC")
(equal ENTTPO "SPLINE")
(equal ENTTPO "ELLIPSE")
)
(progn
(command "_.lengthen" TPNAM "")
(setq LGTPNAM (getvar "PERIMETER")
LGSTOTAL (+ LGTPNAM LGSTOTAL)
)
)
)
)
)
(princ "\n»» Nenhuma entidade seleccionada! \n")
)
(setq TXSTOTAL (rtos LGSTOTAL 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 SOMAPER \n")
;;; Fim Soma_Perímetros.lsp
