Asignar elevación a vértice de poly3D

Buen día señores.
He buscado en mis apuntes y no encontré como resolver mi problema.
Tengo varias polis3D, con un texto "junto" a sus vértices. Hice la rutina para leer el texto, pero no supe como asignarlo al vértice de la poli3d.
Alguna sugerencia?

Saludos y gracias.......
La rutina no tiene mucho chiste...

Código:


(vl-load-com)
(defun c:ponelev()
  (while(/=(setq texto(car(entsel "\n Texto con elevación...")))nil)
    (setq obtxt(vlax-ename->vla-object texto))
    (setq txt(vl-string-subst "" "NPT"(vlax-get-property obtxt 'textstring)))
    (setq elev(distof txt))
    ;--------------------------------------------
    (setq pto(getpoint "\Selecciona Vértice..."))
    ;------aquí ya no supe como asignarle la elevación al vértice...

    )
  )
          


Hola Elías

Primero un poco de teoría:

Las polilíneas 3D tienen alguna particularidad tanto en ActiveX como en DXF.

Si trabajamos con ActiveX las coordenadas se manejan en un vector (safearray) que no se guarda agrupado como lista de puntos ((x1 y1 z1) (x2 y2 z2) ...) sino como un vector lineal (x1 y1 z1 x2 y2 z2 x3...). Para modificar una coordenada hay que determinar el indice de la misma (por ejemplo z2 está en la posición 5 - como si fuese el (nth 5 L) de la lista), cambiar el valor (generalmente con vlax-safearray-put-element) y asignarle las coordenadas con el cambio a la poli de nuevo.

Si trabajamos con DXF también hay una peculiaridad, las polilineas 3D son entidades complejas como las definiciones de bloque, cada vertice se guarda como una entidad diferente, por lo tanto no podemos ver las coordenadas en la lista (entget poly) como si hacemos con las polilineas livianas, sino que debemos iterar por la base de datos con entnext desde la entdad polilinea, por cada entidad "Vertex" (que guarda un vértice) hasta localizar el que nos interesa y modificar con entmod el vertice, después de cambiar las coordenadas (cod 10)

Ahora si, el código. Va un ejemplo con cada método.
Para localizar cual es el vértice:
En DXF hice una comparación con equal de cada vértice respecto al punto picado, hasta que aparezca el vértice coincidente.
En ActiveX utilicé la propiedad "parametro" de la polilinea, que al aplicarle fix nos devuelve el número de vértice y luego le apliqué un desplazamiento (multiplicar por 3 y sumar 2) así el valor resultante es la posición en el safearray de coordenadas. Por ejemplo para el tercer vértice, el parámetro es 2.0, y la posición del tercer Z es 8 = 2 * 3 + 2.

Con DXF

Código:


(defun c:test1 ( / ent text pt parar lent vdxf)
   (setq ent   (car (entsel "Polilínea"))
         text   (car (entsel "Texto"))
         pt      (getpoint "Vértice")
   )
   (while
      (and
         (=   (cdr   (assoc
                     0
                     (setq lent   (entget
                                    (setq ent (entnext ent))
                                 )
                     )
                  )
            )
            "VERTEX"
         )
         (null parar)
      )
      
      (if   (equal
               pt
               (cdr (setq vdxf (assoc 10 lent)))
               0.0001
            )
         (progn
            (setq parar t)
            (entmod
               (subst
                  (list   10
                        (cadr vdxf)
                        (caddr vdxf)
                        (distof
                           (cdr
                              (assoc
                                 1
                                 (entget text)
                              )
                           )
                        )
                  )
                  vdxf
                  lent
               )
            )
         )
      )
   )
   (princ)
)


Con ActiveX

Código:


(defun c:test2 ( / obj text pt crds)
   (setq obj   (vlax-ename->vla-object (car (entsel "Polilínea")))
         text   (car (entsel "Texto"))
         pt      (getpoint "Vértice")
   )
   (vlax-safearray-put-element
      (setq crds (vlax-variant-value (vla-get-coordinates obj)))
      (+   2
         (*   3
            (fix
               (+
                  0.5
                  (vlax-curve-getparamatpoint
                     obj
                     (vlax-curve-getclosestpointto
                        obj
                        pt
                     )
                  )
               )
            )
         )
      )
      (distof
         (cdr
            (assoc
               1
               (entget text)
            )
         )
      )
   )
   (vla-put-Coordinates obj crds)
   (princ)
)


profundizando un poco más en el tema se me ocurrió esto.
Seleccionar de una sola vez la polilínea y todos los textos y utilizar el parámetro del punto más cercano de cada texto a la poli para determinar a cual vértice corresponde cada texto. Así, además de hacer una única selección no tienes que ir picando en el punto para localizar el vértice

La única peculiaridad fue que tuve que hacer una copia de la polilínea (almacenada en la variable COP) y llevar todos los vértices de esa copia a elevación cero. Esto por que la función vlax-curve-getclosestpointto que nos da el punto de la polilínea más cercano también computa distancias verticales entonces si los textos tienen elevación cero a deferencia de los vértices no hay garantía de coincidencia. Pero hacemos la copia de la poli, la llevamos a ceros, calculamos a cual vértice corresponde cada texto con las coordenadas x,y de los textos y la polilinea "aplanada", y al final borramos esa polilínea y asignamos las elevaciones respectivas a la poli original (no aplané la original para que sien algún vértice no hay texto este se mantenga con la elevación que ya tenía).

Mira si te sirve y me comentas

Código:


(defun c:test3 ( / i ss nent lent ent dat obj crds lcrd cop vert)
   (if
      (setq i 0
            ss (ssget '((0 . "POLYLINE,*TEXT")))
      )
      (progn
         (repeat (sslength ss)
            (setq nent   (ssname ss i)
                  i       (1+ i)
                  lent   (entget nent)
            )
            (if (= (cdr (assoc 0 lent)) "POLYLINE")
               (setq ent   nent)
               (setq dat   (cons
                              (list
                                 (distof (cdr (assoc 1 lent)))
                                 (cadr (assoc 10 lent))
                                 (caddr (assoc 10 lent))
                              )
                              dat
                           )
               )
            )
         )
         (if   ent
            (progn
            ;Hacer una copia de la polilinea en con elevaciones 0 para que
            ;vlax-curve-getclosestpointto no falle por distanciamientos verticales
               (setq   obj   (vlax-ename->vla-object ent)
                     crds   (vlax-variant-value (vlax-get-property obj 'coordinates))
                     i      0
                     lcrd   (mapcar
                              '(lambda (a)
                                 (if (zerop   (rem
                                                (setq i (1+ i))
                                                3
                                             )
                                    )
                                    0.0
                                    a
                                 )
                              )
                              (vlax-safearray->list crds)
                           )
                     cop   (vla-copy obj)
               )
               (vla-put-Coordinates cop   (vlax-safearray-fill
                                             (vlax-make-safearray
                                                vlax-vbdouble
                                                (cons 0 (1- (length lcrd)))
                                             )
                                             lcrd
                                          )
               )
            ;Reemplazar elevaciones Mediante Arreglos de ActiveX
               (foreach vert dat
                  (vlax-safearray-put-element
                     crds
                     (+
                        (*
                           (fix
                              (+
                                 0.5
                                 (vlax-curve-getparamatpoint
                                    cop
                                    (vlax-curve-getclosestpointto
                                       cop
                                       (cdr vert)
                                    )
                                 )
                              )
                           )
                           3
                        )
                        2
                     )
                     (car vert)
                  )
               )
               (vla-put-Coordinates obj crds)
               (vla-delete cop)
            )
            (princ "No seleccionó una polilínea válida")
         )
      )
   )
   (princ)
)


Buenos días maestro Gerardo.
Priemro que nada muchas gracias por tomarte el tiempo de contestar, luego, como siempre muy ilustrativo. Las dos primeras rutinas las probé con éxtito. La tercera me dio error en:

Código:


(+
                                 0.5
                                 (vlax-curve-getparamatpoint
                                    cop
                                    (vlax-curve-getclosestpointto
                                       cop
                                       (cdr vert)
                                    )
                                 )
                              )


Intenté meterle mano pero no, es de otro nivel. Si puedes ver de que se trata, perfecto, sino, no hay problema, con las otras dos tengo.

Una vez mas, saludos y gracias........

Con gusto hermano

¿Podés pasarme un dibujo donde falla para reproducir el error?
-es porque yo hago una 3dpoly cualquiera, pongo unos textos al azar y parece funcionar bien
(puede ser por aquí o al correo gcmcad@gmail.com)

Muchas gracia maestro.

Envié el archivo al correo que indicaste.

Verás un polígono rojo, éste no es. Del lado izquierdo tracé una 3DPoly.... es a esta a la que quiero insertar las elevaciones. Abran otras varias.

Una vez más, gracias...........

La plataforma no me permie enviar estos archivos.

Al archivo le quité la extensión .dwg y le puse .bak, espero que si lo envíe.

Saludos y gracias

Parece que no lo aceptó.

Ahora le puse extensión txt

OOooopssssssssss

Perdón, Abran--->>> Habrán....

Jajajaja......

I so sorry, lo siento

Pues la probé en tu archivo y me funcionó bien.
Lo único que se me ocurre es que talvés en tus pruebas seleccionaste uno de los textos que no contienen valores numéricos, porque la función distof devuelve nil si no detecta un número en el contenido del texto.

Fijate que cada par "vert" de la lista "dat" es de la forma '(1.1 2.2 3.3) donde 1.1 es la elevación y (cdr dat) son las coordenadas del texto x=2.2, y=3.3. Pero si un texto dice "NPT+0.10" la lista saldrá de la forma '(nil 2.2 3.3), y ahi la rutina fallaba

Le agregué una condición para que se salte los textos que no devuelven valores numéricos válidos, así puedes seleccionar por ventana con más tranquilidad, y si se filtra un texto inválido la rutina se lo saltará.

Código:


(defun c:test ( / i ss nent lent ent elev dat obj crds lcrd cop vert)
   (if
      (setq i 0
            ss (ssget '((0 . "POLYLINE,*TEXT")))
      )
      (progn
         (repeat (sslength ss)
            (setq nent   (ssname ss i)
                  i       (1+ i)
                  lent   (entget nent)
            )
            (if (= (cdr (assoc 0 lent)) "POLYLINE")
               (setq ent   nent)
               (if   (setq elev (distof (cdr (assoc 1 lent))))
                  (setq dat   (cons
                                 (list
                                    elev
                                    (cadr (assoc 10 lent))
                                    (caddr (assoc 10 lent))
                                 )
                                 dat
                              )
                  )
               )
            )
         )
         (if   ent
            (progn
            ;Hacer una copia de la polilinea en con elevaciones 0 para que
            ;vlax-curve-getclosestpointto no falle por distanciamientos verticales
               (setq   obj   (vlax-ename->vla-object ent)
                     crds   (vlax-variant-value (vlax-get-property obj 'coordinates))
                     i      0
                     lcrd   (mapcar
                              '(lambda (a)
                                 (if (zerop   (rem
                                                (setq i (1+ i))
                                                3
                                             )
                                    )
                                    0.0
                                    a
                                 )
                              )
                              (vlax-safearray->list crds)
                           )
                     cop   (vla-copy obj)
               )
               (vla-put-Coordinates cop   (vlax-safearray-fill
                                             (vlax-make-safearray
                                                vlax-vbdouble
                                                (cons 0 (1- (length lcrd)))
                                             )
                                             lcrd
                                          )
               )
;Reemplazar elevaciones Mediante Arreglos de ActiveX
               (foreach vert dat
                  (vlax-safearray-put-element
                     crds
                     (+
                        (*
                           (fix
                              (+
                                 0.5
                                 (vlax-curve-getparamatpoint
                                    cop
                                    (vlax-curve-getclosestpointto
                                       cop
                                       (cdr vert)
                                    )
                                 )
                              )
                           )
                           3
                        )
                        2
                     )
                     (car vert)
                  )
               )
               (vla-put-Coordinates obj crds)

               (vla-delete cop)
            )
            (princ "No seleccionó una polilínea válida")
         )
      )
   )
   (princ)
)


Prueba de vuelta y me comentas a ver si sería ese el problema.

P.D. Edité la respuesta porque había explicado mal lo del VERT

eliasp escribió:Buenos días maestro Gerardo.
Priemro que nada muchas gracias por tomarte el tiempo de contestar, luego, como siempre muy ilustrativo. Las dos primeras rutinas las probé con éxtito. La tercera me dio error en:

Código:


(+
                                 0.5
                                 (vlax-curve-getparamatpoint
                                    cop
                                    (vlax-curve-getclosestpointto
                                       cop
                                       (cdr vert)
                                    )
                                 )
                              )


Intenté meterle mano pero no, es de otro nivel. Si puedes ver de que se trata, perfecto, sino, no hay problema, con las otras dos tengo.

Una vez mas, saludos y gracias........

Ni tan del otro mundo. Mira
He guardado los datos de los textos en una lista de la forma '( (elev1 x1 y1) (elev2 x2 y2) ...)
Eso me resulta muy conveniente porque se puede crear facilmente

Código:

(cons
   (atof (cdr (assoc 1 lent)))
   (cdr (assoc 10 lent))
)

(Solo que esta vez eliminé el valor Z del punto porque la idea es comparar cercanía de los puntos con la polilínea que llevamos a ceros.)
... y luego leer fácilmente también, porque (car vert) me devuelve el valor de elevación y (cdr vert) las coordenadas

Luego en ese foreach lo que hacemos es pasarle las coordenadas (cdr vert) a vlax-curve-getclosestpointto para que nos dé el punto más cercano al texto que está sobre la polilinea copiada cop
y ese punto sobre la poly lo recibe vlax-curve-getparamatpoint para devolvernos el parámetro, que es un número real que representa la posición del punto a lo largo de la polilínea.

Un parámetro de 0.75 por ejemplo refiere a un punto ubicado a un 75% de la distancia en el primer tramo de la poly (o sea desde el vértice 0 al 1), y un parámetro de 2.54 por ejemplo refiere a un punto ubicado al 54% de la distancia entre los vértices 2 y 3 (tercer tramo)

Entonces al aplicarle fix al parámetro y quedarme con la parte entera obtengo el # de vértice inmediato anterior al "punto más cercano" que me devolvió vlax-curve-getclosestpointto
Pero un parámetro de 2.95 está casi en el vértice 3, y al hacer el fix se irá a 2, que es el vértice anterior. Por eso le sumo el 0.5. Así el (fix (+ param 0.5)) hace que los parámetros de 2.5 a 3.5 se fijen en 3 y de 3.5 a 4.5 se fijan en 4 etc...
Así después del fix ya tenemos el # de vértice que es más cercano al texto.

Luego lo de multiplicar por 3 y sumar 2 ya lo aclaré antes. Como lo que estoy buscando son posiciones de Z en una lista que es de la forma
(X1 Y1 Z1 X2 Y2 Z2 X3 Y3 Z3 X4...)
entonces si el vértice es cero el valor a cambiar es el tercero -> (nth 2)
para el vértice 1 (segundo) el valor es el sexto --> (nth 5)
para 2 el octavo y para 3 el decimo primero, etc

Al multiplicar por 3 y sumarle 2 obtengo esa posición, entonces vlax-safearray-put-element pondrá el valor de elevación del texto (car vert) en esa posición de la lista crds.

Disculpa que me extienda tanto con explicaciones, es mi forma...

Pues que caray maestro....

Lo mismo, se "atora" donde mismo... será que tengo alguna variable del sistema con valor diferente?

No se si tenga que ver la versión, tengo el Autocad 2022....
Tampoco pude insertar imagenes...

En fin...

Ya no le pierdas tiempo maestro.... te agradezco

¿Que será?

Y si activas el break en el vlide y lo corres desde ahí que clase de error te da?
o al parar en el break que valores tienen las variables VERT y COP?

Hola maestro, buen día. De hecho siempre ejecuto los lisp desde el velide y si tengo activado el breack y con F9 me dirige al punto de error, en fin. Te envié por correo imagen de la pantalla, espero sea ilustrativo

Saludos y gracias

Ya vi cual es el error.

Solo ocurre en AutoCad 2022, yo la estuve probando sobre tu archivo en 2023 y nunca falló, pero en 2022 si me ocurre tu mismo fallo.

Y es un error de precisión interna de coordenadas

Resulta que tu dibujo está demasiado lejos del origen para que los valores sean manejados con suficientes decimales. Al guardarse los valores en notación de punto flotante, entre más grande sea la parte entera, menos presición tiene la parte decimal...
Y al parecer el punto devuelto por la función vlax-curve-getclosestpointto, que es calculado sobre la poly viene con un redondeo decimal que en la función vlax-curve-getparamatpoint no se determina que el punto esté justo sobre la polilínea, entonces esta devuelve nil.

No sé si en AutoCad 2023 aumentaron la precisión de esas mantisas o mejoraron algo en las vlax-curve, pero en esta versión no falla.

Si en 2022 muevo manualmente el dibujo cerca del origen para que los valores de las coordenadas sean más chicos ahí si que no me falla.

Y bueno, creo que por ahí iría el parche, que a continuación te dejo. Desplazar la polilínea cop y las coordenadas de los textos para calcular parámetros cerca del origen y aplicarlos en la posición actual de tu poli.
Sin estar seguro por otros posibles fallos por precisión, la siguiente modificación hizo que me funcionara en el 2022:

Código:

(defun c:test ( / i ss nent lent ent elev dat obj pt1 crds lcrd cop vert)
   (if
      (setq i 0
            ss (ssget '((0 . "POLYLINE,*TEXT")))
      )
      (progn
         (repeat (sslength ss)
            (setq nent   (ssname ss i)
                  i       (1+ i)
                  lent   (entget nent)
            )
            (if (= (cdr (assoc 0 lent)) "POLYLINE")
               (setq ent   nent)
               (if   (setq elev (distof (cdr (assoc 1 lent))))
                  (setq dat   (cons
                                 (list
                                    elev
                                    (cadr (assoc 10 lent))
                                    (caddr (assoc 10 lent))
                                 )
                                 dat
                              )
                  )
               )
            )
         )
         (if   ent
            (progn
            ;Hacer una copia de la polilinea en con elevaciones 0 para que
            ;vlax-curve-getclosestpointto no falle por distanciamientos verticales
               (setq   obj   (vlax-ename->vla-object ent)
                     pt1   (vlax-curve-getstartpoint obj)
                     crds   (vlax-variant-value (vlax-get-property obj 'coordinates))
                     i      0
                     cop   (vla-copy obj)
               )
               ;mover la polilinea copiada cerca del origen
               (vla-move
                  cop
                  (vlax-3D-point (list (car pt1) (cadr pt1)))
                  (vlax-3D-point 0. 0.)
               )
               ;Asegurar todos los vertices de la copia en z=0 asignale a cop un nuevo vector de coordenadas, tomado
               ;de sus mismas coordenadas y reemplazando los Z con 0.
               (setq lcrd   (vlax-safearray->list
                              (vlax-variant-value
                                 (vlax-get-property cop 'coordinates)
                              )
                           )
               )
               (vla-put-Coordinates cop   (vlax-safearray-fill
                                             (vlax-make-safearray
                                                vlax-vbdouble
                                                (cons 0 (1- (length lcrd)))
                                             )
                                             (mapcar
                                                '(lambda (a)
                                                   (if (zerop   (rem
                                                                  (setq i (1+ i))
                                                                  3
                                                               )
                                                      )
                                                      0.0
                                                      a
                                                   )
                                                )
                                                lcrd
                                             )
                                          )
               )
;Reemplazar elevaciones en obj Mediante Arreglos de ActiveX
               (foreach vert dat
                  (vlax-safearray-put-element
                     crds
                     (+
                        (*
                           (fix
                              (+
                                 0.5
                                 (vlax-curve-getparamatpoint
                                    cop
                                    (vlax-curve-getclosestpointto
                                       cop
                                       ;desplazar cada posición de texto con la poli movida
                                       (mapcar
                                          '-
                                          (cdr vert)
                                          pt1
                                       )
                                    )
                                 )
                              )
                           )
                           3
                        )
                        2
                     )
                     (car vert)
                  )
               )
               (vla-put-Coordinates obj crds)

               (vla-delete cop)
            )
            (princ "No seleccionó una polilínea válida")
         )
      )
   )
   (princ)
)


por cierto, revisa en el dibujo que solo haya una polilinea, porque cada vez que la rutina falló dejó una copia de la misma superpuesta. Habría que agregarle una función *error* que borre la copia, te lo dejo si te hace falta
Solo ten cuidado de saber a cual poli se le modificaron las elevaciones si es que hay varias superpuestas

Buenos días.

Pues bien, se ha obtenido el resultado requerido. Primero moví los textos y la poli cerca del 0,0 y funcionó. Luego, corrí la rutina en una máquina con ACAD 2023 sin mover nada, funcionó.

Muchas gracias maestro.

eliasp escribió:Buenos días.

Pues bien, se ha obtenido el resultado requerido. Primero moví los textos y la poli cerca del 0,0 y funcionó. Luego, corrí la rutina en una máquina con ACAD 2023 sin mover nada, funcionó.

Muchas gracias maestro.

Excelente
Con todo gusto y que bueno que te funcionó

Y la última versión que puse; ¿en el Acad 2022 sin mover nada también lo hizo?

Buen día maestro, gracias por el interés. Sabes... esta versión no da error, pero tampoco cambia los valores. Como te digo, ya déjalo, corriendola en 2023 funciona muy bien, ya no le pierdas mas tiempo.

Muchas gracias

eliasp escribió:Buen día maestro, gracias por el interés. Sabes... esta versión no da error, pero tampoco cambia los valores. Como te digo, ya déjalo, corriendola en 2023 funciona muy bien, ya no le pierdas mas tiempo.

Muchas gracias

Que extraño a mi me funciona bien
No será que tienes varias más de una poli (superpuestas)? parece algo tonto, pero a mi me pasó con tu archivo, porque justo la copia que me dejó la misma rutina en algún corte por fallo es la que estaba revisando y me daba elevación cero cuando debajo de esa estaba la modificada con elevaciones correctas

Pues maestro, ni que decir.

Funciona perfecto. Efectivamente, la poli que revisé era la copia. Pero ya sabiendo de que se trata, está genial. Muchas gracias y una disculpa por tardar en contestar y confirmar, pero los bomberazos están a la orden del día.

Una vez más, muchas gracias.........