AutoCAD: área delimitada por varias líneas

[lolape]

Hola, creo que hay una aplicación para AutoCAD que permite saber el área delimitada por varias líneas señalando un punto en el interior de la misma, a la vez que coloca automáticamente un rótulo con la superficie. ¿Alguien la conoce?
Muchas gracias.

[LGOMEZ]

Para hacer la polílinea puedes usar la orden BOUNDARY (Contorno), lo otro uso un lsp, lo busco y te le envío.

[monolake]

yo tengo una aplicación de autolisp que se llama arearótulo, y te pone un rótulo con el área al picar dentro de una superficie cerrada

[LGOMEZ]

NOMBRE ARCHIVO: AreaMultipol.lsp
DESCRIPCION: Pone el texto con la superficie y el perímetro de una polilínea.
PLATAFORMA CAD: Antigüo foro Hispacad – Actual Soporte Cad


;;; Copyright ©2004 by draftteam softwar

;;; All rights reserved

;;;

;;; DRAFTTEAM PROVIDES THIS PROGRAM SOFTWARE "AS IS" AND WITH ALL
;;; FAULTS. DRAFTTEAM SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY
;;; OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. DRAFTTEAM
;;; SOFTWARE DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL
;;; BE UNINTERRUPTED OR ERROR FREE

;;;

;;; code: José Luis García


;;; modificion sobre la original para que ponga tb el perimetro

;;; http://www.draftteam.com

;;; ------------------------------------------------------------------------------------
(vl-load-com)
;;-----------------------c:AreaMultiPol-------------------------------------------------
;;calcula el area y el perimetro de multiples polilineas
;; -------------------------------------------------------------------------------------

(defun c:AreaMultiPol ( / sele cod Htxt$ ListaAreas ListaPerim mens TotArea TotPerim mens)
(setq TotArea 0.0 TotPerim 0.0)
(or HTxt (setq HTxt (getvar "TEXTSIZE")))
(initget 6)
(if (setq Htxt$ (getdist (strcat "\nAltura de texto;< " (rtos Htxt) " >: ")))
(setq HTxt Htxt$)
)
(prompt "\nSeleccione Polilineas para suma de Areas: ")
(if (setq sele (ssget (list '(0 . "LWPOLYLINE"))))
(progn
(vl-cmdf "_.UNDO" "_BE")
(setq Cod 0 )
(mapcar (function (lambda (LwPol / Centroid Area$ Perim$)
(setq Area$ (vlax-curve-getArea LwPol)
Perim$ (vlax-curve-getDistAtParam LwPol (vlax-curve-getEndParam LwPol)))
(setq TotArea ( TotArea Area$)
TotPerim ( TotPerim Perim$))
(setq Centroid (CentroidePol LwPol))
(XDraw_Txt HTxt Centroid (strcat "S.Util: " (rtos Area$ 2 2) " m2") 256 4 0) ;paso a poner el texto del area en el centro del poligono
(XDraw_Txt HTxt (POLAR Centroid (* 1.5 PI) (* 1.5 HTxt)) (strcat "P: " (rtos Perim$ 2 2) " ml") 256 4 0) ;paso a poner el texto del perimetro en el centro del poligono
(setq Cod (1 Cod))
(prompt (strcat "\rSe Analizarón " (itoa Cod) " Polilineas..."))
)) (SsToList sele));c.mapcar
(if (setq pick_pt (getpoint "\nPunto insercion suma areas: "))
(progn
(XDraw_Txt HTxt pick_pt (strcat "Total area = " (rtos TotArea 2 2) " m2") 256 4 0)
(XDraw_Txt HTxt (POLAR pick_pt (* 1.5 PI) (* 1.5 HTxt)) (strcat "Total Perimetro = " (rtos TotPerim 2 2) " ml") 256 4 0)
)
)
(princ)
(if (not (zerop TotArea))
(progn
(setq mens (strcat "\nListado de Areas:\n\n"
"Nº de Polilineas Seleccionadas: " (itoa (sslength sele)) " \n\n"
"Area Total: \t" (rtos TotArea) "\n"
"Perimetro Total:\t" (rtos TotPerim) "\n"))
(alert mens)
)
)
(vl-cmdf "_UNDO" "_E")
);c.prg
(Alert "\nError en SELECCION\n\nNo se seleccionarón Polilineas.")
);c.if
(prin1)
);c.defun

;;---------------------------------------------------------------------------------------
;; dibuja un texto en la pantalla
;; --------------------------------------------------------------------------------------
(defun XDraw_Txt (al p cad col codh codv)
(setq EntTxt
(entmakex
(list '(0 . "TEXT");'(8 . "ARQ_Areas_C_Cuadros")
(cons 62 col)
(cons 40 al)
(cons 1 cad)
'(50 . 0.0) '(41 . 1.0)
(cons 7 (getvar "TEXTSTYLE"))
(cons 72 codh)
(cons 10 p)
(cons 11 p)
(cons 73 codv)
);c.list
);c.entmk
);c.setq
);c.defun

;;-------------------------------------------
;; conjunto de seleccion a lista de entidades
;;-------------------------------------------
(defun SSToList (ss / ssl n)
(if (and ss (= (type ss) 'PICKSET))
(repeat (1 (setq n (1- (sslength ss))))
(setq ssl (cons (ssname ss n) ssl) n (1- n))
);c.repeat
)
ssl
);c.defun

(defun dxf (n eg) (cdr (assoc n eg)))

;----------------------------------------------------
;lista de vertices de LWPOLYLINE
;----------------------------------------------------
(defun GetVertPol (Pol / LPtspol)
(mapcar 'cdr
(vl-remove-if (function (lambda (x) (/= (car x) 10))) (entget Pol)))
)

;;-------------------------------------------------------------------------------
;;; Centroide de LWPOLILINE
;;-------------------------------------------------------------------------------
(defun CentroidePol (Poliline / lVertices Centroide)
(setq lVertices (GetVertPol Poliline)
Centroide (trans (CentroidLisPts lVertices) 0 1) )
) ;_ fin de defun

;;---------------------------- CentroidLisPts -----------------------------------
;; (Centroide de lista de puntos obtenidos de Polilinea)
;;-------------------------------------------------------------------------------
(defun CentroidLisPts (vlist / segno n ttl_area basex basey p1 p2 x1 x2 y1 y2 t_x t_y
t_area t_xm t_ym r_x r_y r_area r_xm r_ym Mx My)
(setq vlist (append vlist (list (car vlist)))
segno (1- (length vlist))
n 0
Ttl_Area 0.0
Mx 0.0
My 0.0
basex (car (nth 0 vlist))
basey (cadr (nth 0 vlist)))
(repeat segno
(setq p1 (nth n vlist)
p2 (nth (1 n) vlist)
x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
t_x (- (* ( x2 x2 x1) 0.333333) basex)
t_y (- (* ( y1 y1 y2) 0.333333) basey)
t_area (* (- y2 y1) (- x2 x1) 0.5)
t_xm (* t_area t_x)
t_ym (* t_area t_y)
r_x (- (/ ( x1 x2) 2) basex)
r_y (- (/ ( basey y1) 2) basey)
r_area (* (- x2 x1) (- y1 basey))
r_xm (* r_area r_x)
r_ym (* r_area r_y)
Ttl_Area ( Ttl_Area t_area r_area)
Mx ( Mx t_xm r_xm)
My ( My t_ym r_ym)
n (1 n)) ;_ c. setq
) ;_ c. repeat
(list ( (/ Mx Ttl_Area) basex) ( (/ My Ttl_Area) basey))) ;c. defun
(princ)

[lolape]

Gracias, LGOMEZ.

[lolape]

yo tengo una aplicación de autolisp que se llama arearótulo, y te pone un rótulo con el área al picar dentro de una superficie cerrada
¿Podrías mandarla también?

[monolake]

dame tu correo y te lo mando o dime como se manda por aquí si es que se puede.