acad hispano
¿Quieres reaccionar a este mensaje? Regístrate en el foro con unos pocos clics o inicia sesión para continuar.

Sumar campos de área

2 participantes

Ir abajo

Sumar campos de área Empty Sumar campos de área

Mensaje por mikarts Sáb Dic 31, 2022 10:34 am

Buenos días y gracias por vuestra ayuda de antemano.
Estoy intentando construir una serie de textos en que se indique las áreas de unas polilíneas y que al final se sumen dichas áreas, pero las áreas deben quedar asociadas a las polilíneas mediante campos para que, cuando se deforme una polilínea, se actualice la lista mediante un regen.

Esto último no es problema.
Mediante este código se extrae el área de una polilínea (pol) y se escribe su superficie en un campo asociado:
Código:
(setq stringtx
 (strcat "Su= "
 "%<\\AcObjProp Object(%<\\_ObjId "
 (itoa (vla-get-ObjectID (vlax-ename->vla-object pol)))
 ">%).area \\f \"%lu2%pr2\">%"
 " m²"
 )
  )
  (setq vltx (entmakex
       (list
 (cons 0 "TEXT")
 (cons 7 (getvar "TEXTSTYLE"))
 (cons 1 stringtx)
 (cons 40 0.1)
 (cons 72 1)
 (cons 10 punt)
       )
     )
  )
  (vl-cmdf "_updatefield" vltx "")

El problema me viene al pretender crear la suma.
Se me ocurre sumar los valores que voy obteniendo y almacenarlos en una variable, pero así no se actualizaría en caso de deformar alguna polilínea.
¿Alguien me puede ayudar?
Muchas gracias.

mikarts

Mensajes : 3
Fecha de inscripción : 31/12/2022

Volver arriba Ir abajo

Sumar campos de área Empty Re: Sumar campos de área

Mensaje por Luis Alberto Benitez Lun Ene 02, 2023 1:08 pm

Que tal mikarts
Creo que este lisp es el que buscas probar y comentar
Código:
;;------------------------=={ Areas de Campo }==------------------------------------------------;;
;;                                                                                      ;;
;; Este programa permite a un usuario crear un objeto que contiene un TextoM            ;;
;; Expresión de campo hace referencia a la zona, o la suma de las áreas, de uno o       ;;
;; varios objetos seleccionados.                                                        ;;
;;                                                                                      ;;
;; Tras la emisión de la sintaxis del comando 'A2F' en la línea de comandos de AutoCAD, ;;
;; el usuario tiene que hacer una selección de objetos para los que desea               ;;
;; recuperar la zona; si se selecciona más de un objeto, el                             ;;
;; área acumulada de todos los objetos se mostrará por la resultante                    ;;
;; TextoM campo.                                                                        ;;
;;                                                                                      ;;
;; Después de la selección de objetos, se solicita al usuario que seleccione un punto   ;;
;; en el que crear el campo TextoM. Si el punto especificado reside                     ;;
;; dentro de una celda de la tabla de AutoCAD, el programa rellenará la tabla           ;;
;; celda con la expresión de campo apropiado.                                           ;;
;;                                                                                      ;;
;; El campo mostrará la suma de las áreas de la seleccionada                            ;;
;; objetos, con formato utilizando el campo de formato de código especificadas en       ;;
;; la parte superior del programa - el código de formato puede ser alterado para        ;;
;; satisfacer los requisitos del usuario.                                               ;;
;; Para ver resultado Realizar Regen.                                                   ;;
;;                                                                                      ;;
;;--------------------------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright :copyright: 2014  -  www.lee-mac.com                              ;;
;;--------------------------------------------------------------------------------------;;
;;  Version 1.3    -    2014-07-17                                                      ;;
;;--------------------------------------------------------------------------------------;;

(defun c:a2f ( / *error* fmt inc ins lst sel str )

(setvar "cmdecho" 0);Para visualizar en linea de comando valor 1

(setvar "textsize" 2 );Para altura de Texto

(command "-UNITS" "2" "2" "2" "3" "0" "N");Decimales:2,Sistema de Medida Angular Grados/Minutos/Segundos:2,N° de Fracciones p/Indicar:3,Dirección del Angulo Este:0,Medir Angulo en Sentido Horario:N(No)


    (setq fmt "%lu6%qf1") ;; Formateo de campo

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (if (and (setq sel (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE"))))
             (setq ins (getpoint "\nPunto de Inserción del Texto: "))
        )
        (progn
            (if (setq tmp
                    (ssget "_X"
                        (list '(0 . "ACAD_TABLE")
                            (if (= 1 (getvar 'cvport))
                                (cons 410 (getvar 'ctab))
                               '(410 . "Model")
                            )
                        )
                    )
                )
                (repeat (setq idx (sslength tmp))
                    (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
                )
            )
            (if (= 1 (sslength sel))
                (setq str
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
                        ">%).Area \\f \"" fmt "\">%"
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:ObjectID (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                                ">%).Area>%" " + "
                                lst
                            )
                        )
                    )
                    (setq str
                        (strcat
                            "%<\\AcExpr "
                            (apply 'strcat (reverse (cdr (reverse lst))))
                            " \\f \"" fmt "\">%"
                        )
                    )
                )
            )
            (LM:startundo (LM:acdoc))
            (if (setq tmp (LM:getcell tab (trans ins 1 0)))
                (apply 'vla-settext (append tmp (list str)))
                (vla-addmtext
                    (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                    (vlax-3D-point (trans ins 1 0));5=1
                    0.0
                    str
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; ObjectID - Lee Mac
;; Devuelve una cadena que contiene el ID de objeto de un VLA-Object suministrado
;; Compatible con sistemas de 32 bits y de 64 bits
 
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)

;; Obtener Cell - Lee Mac
;; Si el punto suministrado se encuentra dentro de un límite de la célula,
;; devuelve una lista de: (<VLA Tabla Objeto> <Row> <Col>)

(defun LM:getcell ( lst pnt / dir )
    (setq dir (vlax-3D-point (trans (getvar 'viewdir) 1 0))          
          pnt (vlax-3D-point pnt)
    )
    (vl-some
       '(lambda ( tab / row col )
            (if (= :vlax-true (vla-hittest tab pnt dir 'row 'col))
                (list tab row col)
            )
        )
        lst
    )
)
 
;; Iniciar Deshacer - Lee Mac
;; Abre un Grupo Deshacer.
 
(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)
 
;; Fin Undo - Lee Mac
;; Cierra un Grupo Deshacer.
 
(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)
 
;; Activo Documento - Lee Mac
;; Devuelve el VLA activa de objetos de documento
 
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
 
(vl-load-com) (princ)
(prompt "\n*** nuevo comando a2f definido. ***")
(prin1)
 
;;----------------------------------------------------------------------;;
;;                             Fin del Archivo                          ;;
;;----------------------------------------------------------------------;;

Luis Alberto Benitez

Mensajes : 112
Fecha de inscripción : 29/03/2016

Volver arriba Ir abajo

Sumar campos de área Empty Re: Sumar campos de área

Mensaje por mikarts Lun Ene 02, 2023 9:12 pm

Pues muchas gracias Luis Alberto. Parece que es exactamente lo que pretendo.
Estaba trabajando en una alternativa que creo que es bastante interesante: guardar las polilíneas en una lista y obtener la suma de sus áreas cada vez, llamando a una especie de regen, pero si consigo adaptar lo que me has dado ¡es genial!
Le doy unas vueltas y os digo.
¡Gracias!

mikarts

Mensajes : 3
Fecha de inscripción : 31/12/2022

Volver arriba Ir abajo

Sumar campos de área Empty Re: Sumar campos de área

Mensaje por mikarts Vie Ene 13, 2023 9:17 am

Buenos días.
He conseguido lo que pretendía, es decir, que se tome el área de una polilínea dibujada previamente por la misma orden (command "_.-boundary" ...) que se almacene en una variable a la que se le van sumando las áreas de las nuevas polilíneas.
De nuevo gracias Luis Alberto.
Os dejo el código que he utilizado tal cual de la orden de Lee Mac y el que he adaptado:
TAL CUAL:
Código:
                   ;; FUNCIONES DE LEE MAC SIN MODIFICAR PARA LA SUMA DE ÁREAS

(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

FUNCIONES ADPTADAS
Código:
   ;; CÁLCULO DE LA SUMA DE ÁREAS
  (DEFUN calcula_suma  ()
    (setq lst ; suma de la planta/vivienda actual
           (vl-list*
             "%<\\AcObjProp Object(%<\\_ObjId "
             (LM:ObjectID
               (vlax-ename->vla-object pol)) ;; pol es la polilínea creada previamente con _.-boundary
             ">%).area>%"
             " + "
             lst
             )
          )
      )



  (DEFUN escribe_suma  ()
    ;; ESCRITURA Y SITUACIÓN DE LA SUMA DE ÁREAS
    (setq str
           (strcat
                  "TOTAL " nvn "   " ;; prefijo
                   "%<\\AcExpr "
                   (apply 'strcat (reverse (cdr (reverse lst))))
                   " \\f \"%lu2%pr2%ds44\">%" ;; cambio el formato a lo que me interesa
                   " m²" ;; sufijo
                   )
          )

    (setq txsumarea
           (vla-addmtext
             (vlax-get-property
               (LM:acdoc)
               (if (= 1 (getvar 'cvport))
                 'paperspace
                 'modelspace))
             (vlax-3D-point (trans xysumarea 1 0))
             0.0
             str
             )
          )
    (vla-put-layer txsumarea "superarea-txt")
    (vla-put-AttachmentPoint txsumarea 7) ;; cambia el punto de inserción del mtext
    (setq nvn nil) ;; vacía el nombre de la planta/vivienda actual
    (setq lst nil) ;; vacía la suma de la planta/vivienda actual
    ) ;_ fin de DEFUN (escribe_area)

Muchas gracias por vuestra ayuda.

mikarts

Mensajes : 3
Fecha de inscripción : 31/12/2022

A robierzo le gusta esta publicaciòn

Volver arriba Ir abajo

Sumar campos de área Empty Re: Sumar campos de área

Mensaje por Luis Alberto Benitez Vie Ene 13, 2023 1:21 pm

Que tal mikarts.
Me alegra que estés perfeccionando el lisp para tu requerimiento.
Si puedes Colocar el Lisp Completo.
Gracias

Luis Alberto Benitez

Mensajes : 112
Fecha de inscripción : 29/03/2016

Volver arriba Ir abajo

Sumar campos de área Empty Re: Sumar campos de área

Mensaje por Contenido patrocinado


Contenido patrocinado


Volver arriba Ir abajo

Volver arriba

- Temas similares

 
Permisos de este foro:
No puedes responder a temas en este foro.