AutoCAD Área delimitada por varias líneas

lolape

Novel
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

Bronce
Para hacer la polílinea puedes usar la orden BOUNDARY (Contorno), lo otro uso un lsp, lo busco y te le envío.
 
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

Bronce
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


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