Rotular texto dentro de polilinea cerrada.

Hola. Necesito saber cómo se podría hacer para rotular un texto dentro de una polilinea cerrada. Yo había pensado en utilizar el centroide. Y para polígonos regulares o polilineas con formas más o menos regulares funciona correctamente calculando el centroide. Pero el problema surge cuando son polilineas irregulares con formas exageradamente cóncavas o convexas. Entonces el centroide queda fuera de la polilinea y ya no sirve el algoritmo.

Necesito una idea de cómo rotular siempre el texto dentro de la polilinea cerrada, sea cual sea la forma de la polilinea.
Las polilineas siempre son de tramos rectos. Nunca tienen tramos curvos.

¿Alguna idea?

Saludos.

https://www.dropbox.com/s/8p60q4qqsuq0vd2/texto%20interior%20a%20polilinea.dwg?dl=0

Yo tengo algo por ahí que te buscaré (estaré muy liado hasta el lunes) pero consiste en hallar los ejes principales de inercia y trazar por uno de ellos (el mas horizontal) una recta hasta que corte a la poli. El texto se locarizaría en mitad de la línea.

Igual alguien tiene una mejor solución ...

Un saludo

Si ya tienes el lisp que pone los textos , conviene que el texto este justificado MIDDLECENTER o mediocentro , con ese punto buscas el punto mas cercano a la poli y haces una linea auxiliar entre el punto de inserción y el punto mas cercano , luego busca las dos intersecciones de la linea con la poly , obtienes el punto medio entre las dos intersecciones, y mueves el texto a ese punto medio , borra la linea
Para esto hacen falta usar estas funciones VL

VLAX-ENAME->VLA-OBJECT
VLA-GET-TEXTALIGNMENTPOINT
VLAX-CURVE-GETCLOSESTPOINTTO
VLA-ADDLINE
VLA-INTERSECTWITH
VLA-MOVE
VLA-DELETE

O.K. Gracias a los dos. La de Gabriel me parece una buena opción. Probaré con eso. La opción de Nolo no la entiendo. Eso de los ejes de inercia me suena a chino, maestro. jeje. Saludos.

Lo que propone Gabriel y lo que propongo yo, es prácticamente lo mismo con la única diferencia de que el traza uniendo el cdg con el punto mas cercano y yo la propongo por uno de los ejes de inercia, que a los efectos práctico actúa como simetría de masas y se acerca mas a donde yo pondría el texto en multitud de figuras cuasi-simétricas, como las L de brazos iguales, algunos brazos de estrella etc
De todas formas, no encuentro como lo resolví así que tengo que empezar de nuevo porque además es una rutina que me prepare para montar en otras, antes del penúltimo cambio de máquina..

Un saludo

O.K. Gracias Nolo. Se agradece la dedicación.

Bueno, me tuve que volver a hacer la rutina y de paso he montado la propuesta de Gabriel.
Así que se ve que los resultados son muy parecidos en las dos versiones solo que la de Gabriel con menos código.
Con la de vueltas que le dí, no se como no se me ocurrió antes aproximar por el punto mas cercano.

Aquí dejo las dos versiones

Código:

(DEFUN C:jeje1 ( / obj lobj cdg area pn ints i ln )
;;(vl-load-com)
;; propuesta DEVITG interpretada por NOLO
(if (setq obj (ssget "_+.:E:S" '((0 . "LWPOLYLINE"))))
 (if (zerop (logand 1 (cdr (assoc 70 (entget (ssname ent 0))))))
 (princ "\nNo cerrado ...")
 (progn
 (setq lobj (mapcar 'cdr (vl-remove-if-not '(lambda(a)(member (car a) '(10 11)))(entget(ssname obj 0)) ))
 cdg (mapcar '/ (list (apply '+ (mapcar 'car lobj))(apply '+ (mapcar 'cadr lobj)))(list (length lobj)(length lobj)))
 obj (vlax-ename->vla-object (ssname obj 0))
 area (vlax-get-property obj 'Area)
 pn  (vlax-curve-getclosestpointto obj cdg)
 )
 (entmake (list '(0 . "LINE")(cons 10 cdg)(cons 11 pn) ))(setq ln (entlast))
 (setq ints (vlax-invoke (vlax-ename->vla-object ln)'IntersectWith  obj acExtendThisEntity)
 i 0 ;; nos vamos a quedar con el p-medio los dos primeros puntos
 ints (vl-remove-if '(lambda(a)(> (setq i (1+ i)) 6) )  ints)
 ints (list (cdddr ints)(reverse(cddr (reverse ints))))
 ints (mapcar '(lambda(a b)(/(+ a b)2))(car ints)(cadr ints))
 )
 (entdel ln)
 (entmake (list '(0 . "TEXT")(cons 10 ints)
 (cons 40 (getvar "textsize"))
 (cons 1 (rtos area 2 2))
   (cons 7 (getvar "TEXTSTYLE"))
   '(71 . 0)'(72 . 4);; alineación texto
 (cons 11 ints)
 ))
 ))
 (Princ"\nNo es polilínea ..")
)
(princ)
)

Código:

(DEFUN C:jeje2 ( / ent obj cdg area px py pn ln ints i )
;;(vl-load-com)
;;; propuesta NOLO con semi-vlisp
(if (setq ent (ssget "_+.:E:S" '((0 . "LWPOLYLINE,REGION") )))
 (if (zerop (logand 1 (cdr (assoc 70 (entget (ssname ent 0))))))
 (princ "\nNo cerrado ...")
 (progn
 (if (member '(0 . "LWPOLYLINE")(setq pro (entget (ssname ent 0))))
 (progn (entmake (vl-remove-if '(lambda(a)(member (car a)'(-1 5 330)))pro))
 (vl-cmdf "_region"(entlast)"")
 (setq obj (entlast)))
 (setq obj (ssname ent 0))
 )
 (setq obj (vlax-ename->vla-object obj)
 cdg (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'Centroid)))
 ejes (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'PrincipalDirections)))
 area (vlax-get-property obj 'Area)
 px (polar cdg (angle '(0 0) (reverse(cddr (reverse ejes)))) 100)
 py (polar cdg (angle '(0 0) (cddr ejes)) 100)
 pn (mapcar '(lambda(a b)(/(+ a b) 2)) px py)
 )
 (entmake (list '(0 . "LINE")(cons 10 cdg)(cons 11 pn) ))(setq ln (entlast))
 (setq ints (vlax-invoke (vlax-ename->vla-object ln)'IntersectWith  obj acExtendThisEntity) ;;acExtendNone
 i 0 ;; nos vamos a quedar con los dos primeros puntos
 ints (vl-remove-if '(lambda(a)(> (setq i (1+ i)) 6) )  ints)
 ints (list (cdddr ints)(reverse(cddr (reverse ints))))
 ints (mapcar '(lambda(a b)(/(+ a b)2))(car ints)(cadr ints))
 )
 (if (member '(0 . "LWPOLYLINE")(entget (ssname ent 0)))
 (mapcar 'entdel (list ln (vlax-vla-object->ename obj) ))
 (entdel ln)
 )
 (entmake (list '(0 . "TEXT")(cons 10 ints)
 (cons 40 (getvar "textsize"))
 (cons 1 (rtos area 2 2))
   (cons 7 (getvar "TEXTSTYLE"))
   '(71 . 0)'(72 . 4);; alineación texto
 (cons 11 ints)
 ))
 ))
 (Princ"\nNo es ni región, ni polilínea ..")
)
(princ)
)

Px y py son las direcciones de los ejes principales de inercia pero finalmente elegí la dirección pn que es a 45º de px  y que parece que da puntos interiores mas naturales en figuras extrañas

Un saludo

Ufff. No hacía falta que hicieras el código, hombre!!!!! A ver cómo te pago yo ahora este trabajo!!!!! ¿A dónde te envío una caja de cervezas? jejeje
Muchas gracias maestro.!!!!! Te debo una .... grande.
Probaré el código mañana y te cuento.

Saludos.

Como la perdí, la tenía que rehacerla de todas formas para acoplarla a mi rutina de áreas, así que me costaba poco subirla.
En fin, un doble de cerveza con unos percebitos de por allí ...

Un saludo

He probado las dos opciones. Ambas hacen lo que yo quería. Así que está perfecto. Dos por el precio de una. Así da gusto. Muchas gracias Nolo.
Saludos.

Hola Roberto,

Compruieba esto tambien por una solucion sin el uso de intersecciones:

Código:


;;                                                                            ;
;; listpol    by ymg    (Simplified a Routine by Gile Chanteau              ;
;;                                                                            ;
;; Parameter:  en,  Entity Name or Object Name of Any Type of Polyline        ;
;;                                                                            ;
;; Returns:    List of Points in Current UCS                                  ;
;;                                                                            ;
;; Notes:      On Closed Polyline the Last Vertex is Same as First)          ;
;                                                                            ;

(defun listpol (en / i l)
  (repeat (setq i (fix (1+ (vlax-curve-getEndParam en))))
      (setq l (cons (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1) l))
  )
)

;;                                                                            ;
;; get_insidept        by ymg                                                ;
;;                                                                            ;
;;  Returns a point inside a closed polyline                                  ;
;;                                                                            ;
;; Arguments; l,  A point list of every vertices of a poly, where            ;
;;                the irst point equals the last                              ;
;;                                                                            ;
;; Algoritmo:    By Joseph O'Rourke                                          ;
;;                                                                            ;
;;  1. Find p1 a convex vertex of l (Here using Lowest Rightmost point)      ;
;;    and let its adjacent vertices be p0 and p2                            ;
;;                                                                            ;
;;  2. For each remaining vertex v of l do:                                  ;
;;    2a. If v is inside p0 p1 p2,                                          ;
;;          Compute Orthogonal Distance from v to p0 p2                      ;
;;    2b.  Save point v as p if above distance is a new maximum            ;
;;                                                                            ;
;;  3. If no point is inside, returns centroid of p0 p1 p2                    ;
;;      Else returns  midpoint of p p1                                      ;
;;                                                                            ;

(defun get_insidept (l / ap0p2 d maxd p p0 p1 p2 pos x0 x1 x2 xv y0 y1 y2 yv
                        x1-x0  x2-x1  x0-x2  y1-y0  y2-y1  y0-y2)
  (or (equal (car l) (last l)) (setq l (cons (last l) l)))
 
  (setq y1 1.7e308  i 0)
  (mapcar
      (function
        (lambda (p)
            (cond
              ((> (cadr p) y1))
              ((and (= (cadr p) y1) (<= (car p) x1)))
              (t (setq pos i  p1 p  x1 (car p) y1 (cadr p)))
            )
            (setq i (1+ i))
        )
      )
      l
  )
 
  (if (zerop pos)
      (setq p0 (cadr (reverse l)) x0 (car p0)  y0 (cadr p0)
            p2 (cadr l)          x2 (car p2)  y2 (cadr p2)
      )
      (setq p0 (nth (1- pos) l)  x0 (car p0)  y0 (cadr p0)
            p2 (nth (1+ pos) l)  x2 (car p2)  y2 (cadr p2)
      )
  )
  (setq l      (vl-remove p0 (vl-remove p1 (vl-remove p2 l)))
        maxd    0
        p      nil
        ap0p2  (angle p0 p2)
        x1-x0  (- x1 x0)    y1-y0 (- y1 y0)
        x2-x1  (- x2 x1)    y2-y1 (- y2 y1)
        x0-x2  (- x0 x2)    y0-y2 (- y0 y2)
  )     
       
  (foreach v l
      (setq xv (car v)  yv (cadr v))
     
      (if (=  (< (* x1-x0 (- yv y0)) (* (- xv x0) y1-y0))
              (< (* x2-x1 (- yv y1)) (* (- xv x1) y2-y1))
              (< (* x0-x2 (- yv y2)) (* (- xv x2) y0-y2))
          )   
        (if (> (setq d (abs (* (sin (- (angle p0 v) ap0p2)) (distance v p0)))) maxd)
            (setq p v  maxd d)
        )
      )   
  )
  (if p
      (mapcar (function (lambda (a b) (* (+ a b) 0.5))) p p1)                              ; (midpoint p p1)              ;
      (mapcar (function (lambda (a) (/ a 3))) (apply 'mapcar (cons '+ (list p0 p1 p2))))  ; (centroid  (list p0 p1 p2))  ;
  )   
)

(defun c:test ()
  (entmakex (list '(0 . "POINT") (cons 10 (get_insidept (listpol (car (entsel)))))))
) 



YMG, encantando de que gente buena como tu se pase por aquí....
¡ BIENVENIDO !

Respecto a tu rutina, efectivamente, encuentra un punto interior sin problemas, pero para rotular un área, el punto es un poco menos natural que el que encuentran las otras rutinas.
Te adjunto un dwg con las pruebas. Un punto rojo (pdmode 3) con el resultado de la rutina que tu propones y en color 7, algunos resultado de las otras.
en_pol.dwg

Un saludo y otra vez BienVenido

Hola Nolo,

Si hablamos de polilinea irregilares todos los methodos retornan puntos
que no son naturales.

El ideal seria de calcular el Centro de Chebyshev quien es el centro
del circulo mas grande que encaja en un polygono.

Pero con un polygono irregular, la computacion es muy difficil y
necessita Programmacion Lineare.

ymg

Ufff. Hola yves. Bienvenido!!!!! Me alegro mucho de verte por aquí. Esun placer contar contigo. Perdona que no haya contestado antes, pero no había visto tu post. Como siempre, excelentes tus aportaciones. Aunque en este caso, prefiero los resultados que ofrece la rutina de nolo. Queda el punto más centrado.
Gracias en todo caso, amigo.