Obtener Coordenadas y trazar poly en base a algunas de ellas.

Buen día foro, como los trata la vida... todo bien?

Pues ahora vengo con un problemita que, me suena a que se trató, al menos parte de el en alguna ocasión. CONTEXTO.
Tengo un DWG con "pinchemil" (muchas secciones. Entonces, se trata de elegir la ultima capa de la estructura y "calcar" sobre la línea base una polylínea, para con esa, generar una última-última capa. Suena más complicado, pero en realidad creo que no es tanto. Lo resumiría así:
Seleccionar polylínea CERRADA. (aquí no hay problema
Obtener las coordenadas de los vértices (algo de problema)
Elegir los puntos "de abajo" o de base de la polylínea (mucho problema)
Trazar una polylínea con esos puntos (no hay problema)

Cabe aclarar que esa base de la polylínea, puede tener dos o más vértices. Precísamente por eso se me está complicando.
Anexo par de imágenes en donde trato de expolicar:

https://we.tl/t-RqwizkFevM
Aquí está el DWG.

Saludos y gracias

Hola

Obtener las coordenadas de los vertices es sumamente sencillo, tanto si estas trabajando con DXF como con ActivX.

Con DXF, siendo ENT el nombre de entidad de la poli:

Código:

(setq COORDS (mapcar
               'cdr
               (vl-remove-if
                  '(lambda(A)(/= (car A) 10))
                  (entget ENT
               )
)))

con ActiveX, siendo OBJ el nombre de objeto de la poli:

Código:

(setq L (vlax-safearray->list (vlax-variant-value (vla-get-coordinates OBJ))))
(while L
   (setq COORDS (list (car L)(cadr L))
         L   (cddr L)
   )
)
(setq COORDS (reverse COORDS))

Y lo de detectar cuales corresponden a la base si nos pone a pensar un poco, pero al final tambien debe ser relativamente sencillo. Yo te propondría dos posibles soluciones:

1-Verifica si la polilinea esta en sentido horario o antihorario (sumando los angulos internos para compararlos con (* (numlados-2) pi) y entonces tomas todos los segmentos que crezcan hacia la izquierda o derecha (comparando la ccordenada X de cada punto con el siguiente)
ojo,esa fallaría si en alguna parte el trazo hiciera como una 'Z' pero creo que en tus perfiles eso no sucederá

2-Traza una linea vertical imaginaria (o no?) en cada vértice y encuentras las intersecciones de esa linea con la poli. Si la interseccion con menor valor en Y corrresponde con el punto actual ese punto es parte de la base

Ahi te lo dejo, para que te diviertas XD XD

Pero si en algún momento deja de ser divertido, pues yo debo tener resuelto parte de la primera solución, al menos el cálculo de si una secuencia de puntos de poli son horario o antihorario. Avisame si lo ocupas para buscarlo

Hola maestro Gerardo, primeramente gracias por contestar. Y si, tienes razón. La primera parte es sencilla. Yo lo hice así:

Código:


  (setq obj(vlax-ename->vla-object(car(entsel "\n Selecciona Poli CERRADA..."))))
  (setq coo(vlax-get-property obj 'coordinates))
  (setq zz(vlax-safearray->list(vlax-variant-value coo)))


Una vez que tengo la lista de puntos, iba a buscar el de menor Y.... y en base a el pensaba buscar las Y'es que estuvieran "más cerca" en eso estaba peleandome....
Voy a pararle aquí para ver tus sugerencias.

Ya comentaré como me fué.

Saludos y gracias....

ok
en ese codigo (que es básicamente la primera línea del que te puse) solo te falta algo como lo que yo puse en el while y el reverse para separar los puntos
de esto '(X1 Y1 X2 Y2 X3 Y3) a esto '((X1 Y1)(X2 Y2)(X3 Y3)). Sinó el análisis de xs y ys va a ser muy complicado

Otro análisis que se me ocurre que seria muuuuy fácil de programar (comparado con los otros), sería aprovechando que a parecer las fronteras laterales extremas de tu polígono siempre sean verticales.
-Busca el punto más extremo a la derecha y a la izquierda (serán al menos dos de cada lado pero con igual X), ahi estan las verticales.
-Agrupa todos los puntos que tengan esas xs que conforman la separacion entre la base inferior y la superior. Selecciona el de coordenada Y menor en cada vertical. Esos son el inicio y fin de tu trazo. De ahi tienes los limites de la secuencia de la base inferior.
Ötra forma si no tienes control de toda la secuencia seria separar en dos grupos limitados por esas verticales y sacar el promedio de Y de cada grupo, el que tenga promedio más bajo es la base inferior.

El problema de lo que propones con los puntos mas cercanos es que por ejemplo en la imagen que pasaste el mas cercano al punto mas bajo es que que está sobre el, que ya pertenece a la base superior, así que en vez de cercanías tendrías que ver ángulos

-Aisla los dos grupos de puntos que quedan separados por

Creo que lo más sencillo, sería hacer un rectángulo que englobe los puntos de la polilínea que se quieren "offsetear", seleccionar la polilínea y preguntar al usuario el lado al se quiere la nueva polilínea, y luego unir el resultado.

Buen día. Gracias por el aporte. Luego de varias horas de intentar lo que me sugirió Gerardo (obviamente, no estoy a su nivel). Me llam la atención tu sugerencia... a ver. Si ves la primera imagen, sería algo así: Ordenno la lista de puntos por X.... Tomo el primero y el último y calculo auxiliares "arriba de ellos", Luego con el auxiliar izquierdo y el leído derecho genero un ssget buscando los vértices... ¿Algo así? Pero luego surge... si el primero ordenado como saber si es el de arriba o el de abajo...

Uffff... le sigo "talacheando"

Gracias amigos.......

Primera aproximación.... necesita una pulida, pero ahí va...

Código:


(defun c:compara()
  (setq ind 0 base nil reng nil y nil y2 nil reng1 nil)
  (foreach punto coords
    (setq reng(nth ind coords))    
    (setq y(cadr reng))
    (setq reng1(nth (1+ ind) coords))
    (setq y2(cadr reng1))
    (if (< y y2)
      (setq base(cons reng base)))
    (setq ind(1+ ind))
    )
  )


Parece que es el bueno, me falta probarlo mas veces...

Código:


(defun c:compara()
  (setq ind 0 in2 0 base nil reng nil y nil y2 nil reng1 nil)
  (foreach punto coords
    (setq reng(nth ind coords))   
    (setq y(cadr reng))
    (repeat(length coords)   
      (setq reng1(nth in2 coords))
      (setq y2(cadr reng1))
      (if (< (- y 0.15) y2)
        (setq base(cons reng base)))
      (setq in2(1+ in2))
      )
    (setq ind(1+ ind))
    )
  )


Esta sería mi propuesta, en el archivo adjunto viene con todas las funciones necesarias.

https://drive.google.com/file/d/1_URW0cyK6Dx-7JS6uwU9zPWbnx3u3zXs/view?usp=sharing

Código:


(vl-load-com)

(OR mu:thisdrawing
    (SETQ mu:thisdrawing (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
)

(DEFUN c:offseg   (/        EDATA        P1
       P2        POLILINEA     POLILINEAFINAL
       POLILINEANUEVA     POLILINEAOFFSET  POLILINEAVERTICES
       POLYTMP     PUNTOSDENTRO     PUNTOSPOLILINEAFINAL
       X
      )
  (COND
    ((NOT
      (AND
    (SETQ polilinea (SSGET "_+.:E:S" '((0 . "LWPOLYLINE"))))
    (SETQ polilinea (SSNAME polilinea 0))
    (SETQ edata (ENTGET polilinea))
;;;(setq x (nth 14 edata))
    (SETQ polilineaVertices (mu:massoc 10 edata))
      )
    )
    (ALERT "No se seleccionó una polilinea.")
    )
    ((NOT
      (AND
    (SETQ p1 (GETPOINT "\n Selecciona el primer punto del rectangulo: "))
    (SETQ p2 (GETPOINT "\n Selecciona el segundo punto... " p1))
      )
    )
    (ALERT "No se ingresaron los puntos.")
    )
    ((NOT
      (AND (NOT (COMMAND-S "rectangle" p1 p2))
       (SETQ polyTmp (ENTLAST))
       (SETQ polyTmp (VLAX-ENAME->VLA-OBJECT polyTmp))
       (SETQ PuntosDentro (PuntosDentroPline polyTmp polilineaVertices))
      )
    )
    (ALERT "El rectangulo no cubrió parte de la polilinea")
    )
    (T
    (SETQ mu:MS (VLA-GET-MODELSPACE MU:THISDRAWING))
    (SETQ PolilineaNueva (AddLWPoly mu:MS PuntosDentro))
    ;; El valor negativo o positivo tiene que ver con la orientacion de la
    ;; pline
    (SETQ PolilineaOffset (VLA-OFFSET PolilineaNueva 0.40))
    (SETQ PolilineaOffset
       (VLAX-SAFEARRAY-GET-ELEMENT
         (VARIANT-VALUE PolilineaOffset)
         0
       )
    )
    (SETQ PuntosPolilineaFinal
       (APPEND
         (mu:massoc
      10
      (ENTGET   (VLAX-VLA-OBJECT->ENAME PolilineaNueva)
      )
         )
         (REVERSE (mu:massoc
          10
          (ENTGET (VLAX-VLA-OBJECT->ENAME PolilineaOffset)
          )
            )
         )
       )
    )
    (SETQ PolilineaFinal (AddLWPoly mu:MS PuntosPolilineaFinal))
    (VLA-PUT-CLOSED PolilineaFinal :VLAX-TRUE)
    (VLA-PUT-COLOR PolilineaFinal ACRED)
    (MAPCAR '(LAMBDA (x)
      (IF (NOT (VLAX-ERASED-P x))
        (VLA-DELETE x)
      )
         )
       (LIST polyTmp PolilineaNueva PolilineaOffset)
    )
    )
  )
  (VLA-REGEN MU:THISDRAWING ACALLVIEWPORTS)
  (PRINC)
)


(DEFUN mu:massoc (key data)
  (MAPCAR 'CDR
     (VL-REMOVE-IF-NOT
       '(LAMBDA (x) (= (CAR x) key))
       data
     )
  )
)


(DEFUN PuntosDentroPline (pline puntos / PuntosDentro)
  (FOREACH punto puntos
    (IF   (@cv_inside punto pline T)
      (SETQ PuntosDentro (CONS punto PuntosDentro))
    )
  )
  PuntosDentro
)

(DEFUN AddLWPoly (blk lst)
  (VLA-ADDLIGHTWEIGHTPOLYLINE
    blk
    (VLAX-MAKE-VARIANT
      (VLAX-SAFEARRAY-FILL
   (VLAX-MAKE-SAFEARRAY
     VLAX-VBDOUBLE
     (CONS 0 (1- (* 2 (LENGTH lst))))
   )
   (APPLY (FUNCTION APPEND) lst)
      )
    )
  )
)

Esta sería mi segunda propuesta, haciendo como decía Gabriel, seleccioando solo la base de la pollilinea, para eso calculé el MinY y MaxY, para usar MinY como base y la mitad de la distancia entre MinY y MaxY como tolerancia.

Me apasiona el tema de manejo de las polilineas, como se puede apreciar; también intenté replicar como hacer el codigo para el offset, pero me dio muchos problemas, solo logré que los puntos se proyectaran en el plano vertical...:-(

Buen ejercicio, ojalá te sirva.


(or MU:THISDRAWING (setq MU:THISDRAWING (vla-get-ActiveDocument (vlax-get-acad-object))))

(DEFUN c:Offseg2 ()
  (OR mu:MS (SETQ mu:MS (VLA-GET-MODELSPACE MU:THISDRAWING)))
  (COND   ((NOT
     (AND   (SETQ PolilineaBase
            (SSGET "_+.:E:S"
               (LIST '(0
                  .
                  "*POLYLINE"
                )
;;;Puedes usar el codigo siguiente para filtrar por layers
;;;            (CONS 8
;;;             MU:LayUvs
;;;            )
               )
            )
      )
      (SETQ PolilineaBase (ssname PolilineaBase 0))
     )
    )
    (ALERT "No se seleccionó una polilinea...")
   )
   ((NOT
     (AND
       (SETQ PolilineaDirecccion
          (CADR
            (@polydir PolilineaBase)
          )
       )
       (SETQ PolilineaNuevaPuntos
          (ObtienePuntos+Offset
            PolilineaBase
            (* (IF (= PolilineaDirecccion "CW")
           1
           -1
          )
          0.40
            )
          )
       )
       (SETQ PolilineaNueva (AddLWPoly mu:ms PolilineaNuevaPuntos))
     )
    )
    (ALERT "No se pudo crear la polilinea...")
   )
   (T
    (VLA-PUT-CLOSED PolilineaNueva :vlax-true)
    (VLA-PUT-COLOR PolilineaNueva ACRED)
   )
  )
  (PRINC)
)

(DEFUN ObtienePuntos+Offset (ent offset-distance)
;;;(SETQ ent (ENTSEL))
  (COND
    ((NOT
      (AND (SETQ edata (ENTGET ent))
       (SETQ mu:polvtx (massoc 10 edata))
       (SETQ MinY (APPLY 'MIN
               (MAPCAR '(LAMBDA (x)
                (CADR x)
                  )
                  mu:polvtx
               )
            )
        MaxY (APPLY 'MAX
               (MAPCAR '(LAMBDA (x)
                (CADR x)
                  )
                  mu:polvtx
               )
            )
       )
;;;Se toma lamitad del alto como la tolerancia, para saber si los puntos
;;;Estan en la base de la pline
       (SETQ DistanciaMediaY (/ (- MaxY MinY) 2))
       (SETQ PolilineaPuntosBase
        (VL-REMOVE-IF-NOT
          '(LAMBDA (x)
         (EQUAL (CADR x) MinY DistanciaMediaY)
            )
          mu:polvtx
        )
       )
      )
    )
    (ALERT "No hay datos para crear el offset...")
    )
    (T
    (SETQ PolilineaNuevaPuntos
       (APPEND ptsPline
          (REVERSE (offset-points
               ent
               PolilineaPuntosBase
               offset-distance
             )
          )
       )
    )
    )
  )
  PolilineaNuevaPuntos
)

(DEFUN AddLWPoly (blk lst)
  (VLA-ADDLIGHTWEIGHTPOLYLINE
    blk
    (VLAX-MAKE-VARIANT
      (VLAX-SAFEARRAY-FILL
   (VLAX-MAKE-SAFEARRAY
     VLAX-VBDOUBLE
     (CONS 0 (1- (* 2 (LENGTH lst))))
   )
   (APPLY (FUNCTION APPEND) lst)
      )
    )
  )
)

(DEFUN offset-points (ent points offset-distance)
  (MAPCAR
    '(LAMBDA (pt)
;;;      (setq datos (calc-tangente ent pt))
      (POLAR pt
         (/ PI 2)
         offset-distance
      )
    )
    points
  )
)

(DEFUN massoc (key EntData / x nlist)
  (FOREACH x EntData
    (IF   (EQ key (CAR x))
      (SETQ nlist (CONS (CDR x) nlist))
    ) ;_ end of if
  ) ;_ end of foreach
  (REVERSE nlist)
) ;_ end of defun


;;;(setq e (car (entsel)))
;;;(@polydir e)
;; Author John Uden
(DEFUN @polydir   (e / ent etype object coords flag i p1 p2 p3 sum @delta)
      ;|
 Author John Uden
 p - point to test
 ptlst - closed pline point list w/o bulged segments
(defun test (p ptlst / res)
  (setq ptlst (append ptlst (list (car ptlst))))
  (setq   res (apply '+
        (mapcar '(lambda (a b) (@delta (angle p a) (angle p b)))
           ptlst
           (cdr ptlst)
           )
        )
   ) ;(print res)
  (equal (abs res) (* 2 pi) 1e-10)
  )
|;
  (DEFUN @delta   (a1 a2)
    (COND ((> a1 (+ a2 PI)) (SETQ a2 (+ a2 (* 2 PI))))
     ((> a2 (+ a1 PI)) (SETQ a1 (+ a1 (* 2 PI))))
    )
    (- a2 a1)
  )
  (COND   ((/= (TYPE e) 'ENAME) nil)
   ((NOT (VL-POSITION
      (SETQ etype (CDR (ASSOC 0 (SETQ ent (ENTGET e)))))
      '("AECC_CONTOUR" "LWPOLYLINE" "POLYLINE")
         )
    )
;;;    (prompt (strcat " Object selected is a(n) " etype))
   )
   ((AND (SETQ flag (CDR (ASSOC 70 ent)))
         (> (BOOLE 1 16 flag) 0)
    )
;;;    (prompt (strcat " Object selected is a(n) " "3DMESH"))
   )
   (T
    (SETQ object (VLAX-ENAME->VLA-OBJECT e)
         coords (VLAX-GET object "Coordinates")
         coords (@cv_parse_list
         coords
         (IF (= etype "LWPOLYLINE")
           2
           3
         )
            )
         i      1
         sum    0.0
    )
    (AND flag
         (= (LOGAND 1 flag) 1)   ; closed
         (SETQ coords (REVERSE (CONS (CAR coords) (REVERSE coords))))
    )
    (REPEAT (- (LENGTH coords) 2)
     (SETQ p1  (NTH (1- i) coords)
       p2  (NTH i coords)
       i  (1+ i)
       p3  (NTH i coords)
       sum (+ sum (@delta (ANGLE p1 p2) (ANGLE p2 p3)))
     )
    )
    (IF (MINUSP sum)
     (LIST coords "CW")
     (LIST coords "CCW")
    )
   )
  )
)

Buenos días maigos.
Primeramente, agradecer a Marco Jacinto por las dos opciones que me regaló, sin embargo en ambas "faltó algo" Voy a ver los códigos y tratar de modificarlos. En la primera opción, "casi" es lo que se requiere, pero la poli roja debe ser desde la izquierda y derecha, no importa si no la cierra.



En la sgunda opción, esa poli que dibuujas, debería estar en la parte de abajo, pero "sobrepuesta a la base"


En fin, te agradezco amigo, voy a intentar modificar alguna de las opciones, a ver si logro dar con lo que busco.
Saludos y gracias.......

Elias buen día, a que te refieres con "debe ser desde la izquierda y derecha, no importa si no la cierra." ¿que el trazo de la polilinea siga el sentido Horario? si es esto, en el foro subí una aplicacion llamada PLTools que tiene esta funcion o tambien puedes usar la que CAD ya tiene incorporada, se llama "reverse".

Y el código que posteé, tiene dos errores, cambie al final, el nombre de las variables para hacerlos mas legibles, pero olvide uno de ellos, el nombre viejo es ptsPline, debe ser PolilineaPuntosBase, y en la orientacion de la polilinea primero debe ir -1 y luego 1, para que la polilinea se genere hacia abajo, con esto ya debería funcionar a la perfección. No corrijo el código original, para que no se pierda la conversacion, los errores son muy simples y con la explicacioó anterior, cualquiera puede adecuarlo.

Saludos y que bueno que van por el rumbo que necesitas.

Hola Marco, gracias por contestar.

Mira, cuando digo que es de izquierda a derecha, me refiero a que debe ser toda la base, porque en la opción 1 si lo hace bien, pero no en toda la base.... En la imagen de la primera opcion, tracé unas líneas azules, mostrando lo que falta...
Y en la segunda opción si lo hace en toda la extención, pero la dibuja "arriba" y debería ser "abajo".... debe estar "calcada" o superpuesta a la base. Si va en sentido horario o no, eso no importa...

Espero que haya quedado mas claro, por lo pronto, voy a ver lo que dices que encontraste de erro y a corregir.

Saludos y gracias

jejeje, ya vi, a lo que te refieres, en esa primera opcion, solo se copiaran los vertices que queden dentro del rectangulo que hagas, entonces, creo que al hacer este rectangulo, los vertices extremos no estan dentro del rectangulo.

Acabo de recordar la funcion ssnamex, que creo te permite acceder al metodo por el que se seleccionan los objetos, con este, podria filtrar la polilinea, y en una sola accion obtener el rectangulo y la entidad a "offsetear", en una chance pruebo a ver si resulta.

Hola Marco.

He estado analizando los códigos que me hiciste favor de enviar y sabes que, aunque el primero es el que mas se acerca a lo que necesito, hay un detalle que no se puede dejar pasar por alto... Los archvos de secciones transevertsaleas siempre tienen "pinchemil" secciones, entonces no es posible ingresar los puntos que pides:

Código:


    (SETQ p1 (GETPOINT "\n Selecciona el primer punto del rectangulo: "))
    (SETQ p2 (GETPOINT "\n Selecciona el segundo punto... " p1))


Para dibujar el rectangulo, puesto que son muchas secciones, estos rectangulos los seleccionaría son un SSGET.

Mientras le sigo terqueando, a ver que puedo hacer.

Saludos y gracias..........

Pues entonces, el segundo código es el buenos, solo necesitas seleccionar la polilinea a procesar, lo cual lo puedes hacer con un ssget, y el resto ya te la sabes.

Buenas tardes a todos.

Hola Marco. Para comentarte que el código que me compartiste de la opción 2, es precísamente lo que necesito. Le hice la corrección que mencionaste, de primero el -1 y luego el 1. Además le quité la opción que cierra la polilínea y.... es justo lo que necesito... ahora voy a tratar de asimilarlo por si requiero aplicarlo en algún otro problema. Y lo integraré a mi proyecto actual....

Saludos y otra vez, GRACIAS..................

Marco Jacinto.

Como comenté anteriormente, el código que me regalaste es justo loque necesito e intenté llamarlo desde mi rutina principal, sin embargo no he tenido éxtito. Vi que a la selección de la polilínea le obtienes el SSNAME y de ahí sigues, entonces intente llamrlo pasandole como argumento el objeto de mi SSGET y no pude, por ningún medio. Espero puedas orientarme de cómo puedo llamar a Offseg2... éste es el código desde donde intento llamarlo.

Código:


(setq conj(ssget "_X"(list
                         (cons 0 "*line")
                         (cons 8 capa)
                         '(70 . 1)
                         )
                   )
        )
  (repeat(sslength conj)
    (setq ent(ssname conj ind))
    (c:offseg2 ent)

    (setq ind(1+ ind))
    )


Para usar la funcion offseg2 como una con parametros, primero quitale el c: para que no se pueda llamar desde la linea de comandos, despues, agrega el parametro justo a continuacion del siguiente parentesis, puedes llamarle PolilineaBase, para no romper el codigo, y despues eliminar, si quieres el primer not del condicional, o dejarlo como

((not (=(type PolilineaBase) 'ENAME))
(ALERT "No se ingreso una polylinea una polilinea...")
)

Y ya en tu codigo, puedes llamarla con (offseg2 ent) <--- checa que ya no lleva C:

Otra cosa, el codigo esta hecho para funcionar con polilineas, y no funcionara con lineas, splines o heavypolylines, las cuales las estas incluyendo en tu codigo en la funcion ssget (con el "*line").

Buen día foro.

Tardecito pero sin sueño.
Por cuestiones de trabajo y los típicos "bomberazos" no pude conectarme antes, pero quiero agradecer a Marco Jacinto por su rutina "Segunda Propuesta" que con un punto aquí, una coma por allá y sobre todo la guía de como integrarla a mi proyecto, hace exactamente lo que se requiere. Por lo pronto sigo avanzando en esta rutina.

Saludos y gracias....