AutoCAD Área delimitada por varias líneas

#1
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.
 
#2
Para hacer la polílinea puedes usar la orden BOUNDARY (Contorno), lo otro uso un lsp, lo busco y te le envío.
 
#3
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
 
#4
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
Código:
;;; 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
 

;;; ------------------------------------------------------------------------------------
 (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)
 
Arriba