Texto a Polilínea o curvas o lo que sea.

Buen día señores.

El asunto de hoy es el siguiente. Por cuestiones del trabajo, me he visto obligado a exportar partes de dibujo Google earth, el asunto es que cuando se exportan textos, se comportan de una manera no es conveniente, ya que crecen o decrecen según la vista. Entonces, en las express hay un rutina llamada txtexp, que convierte el texto a líneas, pero los deja con mucha talacha por hacer. El asunto es si saben de alguna rutina o método para hacer la conversión y que no se requiera mucha talacha posterior, porque literalmente pueden ser varios cientos de textos.

Elias yo uso el siguiente lisp

Código:

;;--------------------=={ CurveText.lsp }==----------------------------------;;
;;                                                                           ;;
;; Posiciones Texto a lo largo de un objeto de curva (arco, círculo, spline, ;;
;; Elipse, línea, lwpolyline, polilínea), y rota el texto                    ;;
;; Para adaptarse a la curva en consecuencia.                                ;;
;;                                                                           ;;
;; Si se ejecuta en versiones> AutoCAD2000, el texto resultante lo hará      ;;
;; Forman un grupo anónimo.                                                  ;;
;;---------------------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright :copyright: 2012 - www.lee-mac.com                      ;;
;;---------------------------------------------------------------------------;;
;;  Version:  1.4    -    22-02-2012                                         ;;
;;---------------------------------------------------------------------------;;

(defun c:CurveTexto ( / sel str obj )
(command "_.textsize" "6.25");     Para Altura de Texto
(COMMAND "-Estilo" "STANDARD" "" "" "0.8" "0" "" "" "");Factor de Anchura =0.8 , ángulo de oblicuidad <0>=0º

    (cond
        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
            (princ "\nCapa actual Bloqueada.")
        )
        (   (and
                (setq sel
                    (LM:SelectionOrText "\nEspecificar o Seleccionar cadena de texto: "
                        (function
                            (lambda ( x ) (wcmatch (cdr (assoc 0 (entget x))) "*TEXT,ATTRIB"))
                        )
                    )
                )
                (or
                    (and
                        (eq 'STR (type sel))
                        (setq str sel)
                    )
                    (setq str (cdr (assoc 1 (entget sel))))
                )
                (setq obj (LM:SelectIf "\nSeleccione Curva: " 'LM:CurveObject-p))
            )
            (LM:CurveText str obj)
        )
    )
    (princ)
)

(defun LM:CurveText ( str ent / *error* 3pi/2 a1 a2 a3 acdoc acspc df di dr g1 g2 gr in ln lst ms obj p1 p2 p3 pi/2 ts )

    (defun *error* ( msg )
        (foreach obj lst
            (if
                (and
                    (not (vlax-erased-p obj))
                    (vlax-write-enabled-p obj)
                )
                (vla-delete obj)
            )
        )
        (if (null (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
    )
    (or *offset* (setq *offset* 0.0))
    (or *spacin* (setq *spacin* 1.1))

    (setq ts
        (/  (getvar 'textsize)
            (if (LM:isAnnotative (getvar 'textstyle))
                (cond ((getvar 'cannoscalevalue)) ( 1.0 ))
                1.0
            )
        )
    )

    (setq lst
        (mapcar
            (function
                (lambda ( c )
                    (setq obj (vla-addtext acspc (chr c) (vlax-3D-point (getvar 'VIEWCTR)) ts))
                    (vla-put-alignment obj acalignmentmiddlecenter)
                    obj
                )
            )
            (vl-string->list str)
        )
    )

    (setq ms    (princ "\nPosición del Texto: [+/-] Offset, [</>] Espaciado")
          ln    (- (/ (1+ (strlen str)) 2.0))
          pi/2  (/ pi 2.0)
          3pi/2 (/ (* 3.0 pi) 2.0)
    )
    (while
        (progn
            (setq gr (grread t 15 0)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
            (cond
                (   (or (= 05 g1) (= 03 g1))
                    (setq p1 (trans g2 1 0)
                          p2 (vlax-curve-getclosestpointto ent p1)
                          a1 (angle p2 p1)
                          di (vlax-curve-getdistatpoint ent p2)
                          dr (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p2)))
                          df (- a1 dr)
                          in ln
                          a2 (cond
                                 (   (and (> dr pi/2) (<= dr pi))
                                     (- pi)
                                 )
                                 (   (and (> dr pi) (<= dr 3pi/2))
                                     pi
                                 )
                                 (   0.0   )
                             )
                    )
                    (foreach obj
                        (if (and (< pi/2 dr) (<= dr 3pi/2))
                            (reverse lst)
                            lst
                        )
                        (if (setq p3 (vlax-curve-getPointatDist ent (+ di (* (setq in (1+ in)) *spacin* ts))))
                            (progn
                                (setq a3 (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p3))))
                                (vla-put-TextAlignmentPoint obj
                                    (vlax-3D-point (polar p3 (+ a3 df) (* ts *offset*)))
                                )
                                (vla-put-rotation obj (+ a2 a3))
                            )
                        )
                    )
                    (= 05 g1)
                )
                (   (= 25 g1)
                    nil
                )
                (   (= 02 g1)
                    (cond
                        (   (member g2 '(13 32))
                            nil
                        )
                        (   (member g2 '(43 61))
                            (setq *offset* (+ *offset* 0.1))
                        )
                        (   (member g2 '(45 95))
                            (setq *offset* (- *offset* 0.1))
                        )
                        (   (member g2 '(46 62))
                            (setq *spacin* (+ *spacin* 0.05))
                        )
                        (   (member g2 '(44 60))
                            (setq *spacin* (- *spacin* 0.05))
                        )
                        (   (princ (strcat "\nInvalid Keypress." ms))
                        )
                    )
                )
                (   t  )
            )
        )        
    )
    
    (if (< 15.0 (atof (getvar 'ACADVER)))
        (vla-appenditems (vla-add (vla-get-groups acdoc) "*")
            (vlax-make-variant
                (vlax-safearray-fill
                    (vlax-make-safearray vlax-vbObject (cons 0 (1- (length lst))))
                    lst
                )
            )
        )
    )
    (princ)
)

(defun LM:CurveObject-p ( ent )
    (null
        (vl-catch-all-error-p
            (vl-catch-all-apply 'vlax-curve-getEndParam (list ent))
        )
    )
)

(defun LM:SelectIf ( msg pred )
    (
        (lambda ( f / e )
            (while
                (progn (setvar 'ERRNO 0) (setq e (car (entsel msg)))
                    (cond
                        (   (= 7 (getvar 'ERRNO))
                            (princ "\nPerdido, vuelver a intentarlo.")
                        )
                        (   (eq 'ENAME (type e))
                            (if (and f (null (f e)))
                                (princ "\nObjeto no válido.")
                            )
                        )
                    )
                )
            )
            e
        )
        (eval pred)
    )
)

(defun LM:isAnnotative ( style / obj xdt )
    (and
        (setq obj (tblobjname "STYLE" style))
        (setq xdt (cadr (assoc -3 (entget obj '("AcadAnnotative")))))
        (= 1 (cdr (assoc 1070 (reverse xdt))))
    )
)


(defun LM:SelectionOrText ( msg pred / en g1 g2 gr result )
    (setq pred (eval pred))
    
    (if msg
        (princ msg)
        (princ (setq msg "\nSeleccione Objetos o Escriba el Texto: "))
    )
    (setq result "")

    (while
        (progn
            (setq gr (grread t 13 2)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
            (cond
                (   (= 03 g1)
                    (if (setq en (car (nentselp g2)))
                        (if (pred en)
                            (not (setq result en))
                            (princ (strcat "\nObjeto no válido seleccionado." msg))
                        )
                        (princ (strcat "\nPerdido, Inténtar de nuevo." msg))
                    )
                )
                (   (= 02 g1)
                    (cond
                        (   (< 31 g2 127)
                            (setq result (strcat result (princ (chr g2))))
                        )
                        (   (= 13 g2)
                            nil
                        )
                        (   (= 08 g2)
                            (if (< 0 (strlen result))
                                (progn
                                    (setq result (substr result 1 (1- (strlen result))))
                                    (princ (vl-list->string '(8 32 8)))
                                )
                            )
                            t
                        )
                        (   t   )
                    )
                )
                (   (= 25 g1)
                    nil
                )
                (   t   )
            )
        )
    )
    result


)

(vl-load-com)
(princ "\n:: CurveText.lsp | Version 1.4 | :copyright: Lee Mac 2012 www.lee-mac.com ::")
(princ "\n:: Tipear \"CurveTexto\" para Invocar ::")
(princ)

Hola Luis, te agradezco la respuesta, sin embargo, creo que no me expliqué bien.

Lo que necesito es convertir el texto a curvas o líneas, no adaptarlas a una curva. De cualquier forma, está muy bien la rutina.

Una disculpa por no haber explicado bien.

Saludos y gracias,

Explota los textos y luego conviertelos en region y despues unelos con el comando union, que es mas o menos lo que hace este comando.

Código:

;;; MERGE -Gilles Chanteau- 01/01/06
;;; Creates a new closed pline on the boundary of each group of adjoining closed
;;; plines

(DEFUN c:merge (/      err    arcbulge    Space  ss  lst reg Norm
 expl   objs   regs   olst   blst   plst  dlst tlst blg
 pline
       )
  (VL-LOAD-COM)

;;;***************************************************************;;;

  (DEFUN err (msg)
    (IF (= msg "Fonction annulée")
      (PRINC)
      (PRINC (STRCAT "\nErreur: " msg))
    )
    (VLA-ENDUNDOMARK *acdoc*)
    (SETQ *error* m:err
  m:err nil
    )
    (PRINC)
  )

;;;***************************************************************;;;

  (DEFUN arcbulge (arc)
    (/ (SIN (/ (VLA-GET-TOTALANGLE arc) 4))
       (COS (/ (VLA-GET-TOTALANGLE arc) 4))
    )
  )

;;;***************************************************************;;;

  (OR *acdoc*
      (SETQ *acdoc* (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
  )
  (SETQ Space (IF (= 1 (GETVAR "CVPORT"))
  (VLA-GET-PAPERSPACE *acdoc*)
  (VLA-GET-MODELSPACE *acdoc*)
 )
 m:err *error*
 *error* err
  )
  (PROMPT "\nSelect polylines to merge: ")
;;;Se crea un conjunto de seleccion con circulos, lineas o polilineas
  (IF (SETQ ss (SSGET '((0 . "*LINE,CIRCLE,ARC"))))
    (PROGN
      (VLA-STARTUNDOMARK *acdoc*)
;;;Se crean las regiones con los objetos seleccionados
      (SETQ reg
     (VL-CATCH-ALL-APPLY
       'VLAX-INVOKE
       (LIST Space
     'addRegion
     (MAPCAR 'VLAX-ENAME->VLA-OBJECT
     (VL-REMOVE-IF 'LISTP (MAPCAR 'CADR (SSNAMEX ss)))
     )
       )
     )
      )
      (IF (NULL (VL-CATCH-ALL-ERROR-P reg))
 (PROGN
;;;  Se une la primer region de la lista con la siguiente, hasta que se hayan
;;;  procesado todas las regiones.
  (WHILE (CADR reg)
    (VLA-BOOLEAN
      (CAR reg)
      ACUNION
      (CADR reg)
    )
    (SETQ reg (CONS (CAR reg) (CDDR reg)))
  )
;;;La variable reg contiene la region creada con la union de todas las demas que se hayan creado
  (SETQ reg  (CAR reg)
 Norm (VLAX-GET reg 'Normal)
 expl (VLAX-INVOKE reg 'Explode)
  )
;;;  Se borra la region original, ya que se exploto y los objetos que la componen se crean de nuevo
  (VLA-DELETE reg)
  (WHILE expl
    (SETQ objs (VL-REMOVE-IF-NOT
 '(LAMBDA (x)
    (OR
      (= (VLA-GET-OBJECTNAME x) "AcDbLine")
      (= (VLA-GET-OBJECTNAME x) "AcDbArc")
    )
  )
 expl
       )
  regs (VL-REMOVE-IF-NOT
 '(LAMBDA (x) (= (VLA-GET-OBJECTNAME x) "AcDbRegion"))
 expl
       )
    )
    (IF objs
      (PROGN
 (SETQ olst (MAPCAR '(LAMBDA (x)
      (LIST x
    (VLAX-GET x 'StartPoint)
    (VLAX-GET x 'EndPoint)
      )
    )
   objs
   )
 )
 (WHILE olst
  (SETQ blst nil)
  (IF (= (VLA-GET-OBJECTNAME (CAAR olst)) "AcDbArc")
    (SETQ blst (LIST (CONS 0 (arcbulge (CAAR olst)))))
  )
  (SETQ plst (CDAR olst)
 dlst (LIST (CAAR olst))
 olst (CDR olst)
  )
  (WHILE
    (SETQ
      tlst (VL-MEMBER-IF
     '(LAMBDA (x)
 (OR (EQUAL (LAST plst) (CADR x) 1e-9)
    (EQUAL (LAST plst) (CADDR x) 1e-9)
 )
      )
     olst
   )
    )
     (IF (EQUAL (LAST plst) (CADDAR tlst) 1e-9)
       (SETQ blg -1)
       (SETQ blg 1)
     )
     (IF (= (VLA-GET-OBJECTNAME (CAAR tlst)) "AcDbArc")
       (SETQ
 blst (CONS (CONS (1- (LENGTH plst))
  (* blg (arcbulge (CAAR tlst)))
    )
    blst
      )
       )
     )
     (SETQ plst (APPEND plst
 (IF (MINUSP blg)
  (LIST (CADAR tlst))
  (LIST (CADDAR tlst))
 )
 )
   dlst (CONS (CAAR tlst) dlst)
   olst (VL-REMOVE (CAR tlst) olst)
     )
  )
  (SETQ pline
 (VLAX-INVOKE
   Space
   'addLightWeightPolyline
   (APPLY 'APPEND
  (MAPCAR '(LAMBDA (x)
     (SETQ x (TRANS x 0 Norm))
     (LIST (CAR x) (CADR x))
   )
  (REVERSE (CDR (REVERSE plst)))
  )
   )
 )
  )
  (VLA-PUT-CLOSED pline :VLAX-TRUE)
  (MAPCAR
    '(LAMBDA (x) (VLA-SETBULGE pline (CAR x) (CDR x)))
    blst
  )
  (VLA-PUT-ELEVATION
    pline
    (CADDR (TRANS (CAR plst) 0 Norm))
  )
  (VLA-PUT-NORMAL pline (VLAX-3D-POINT Norm))
  (MAPCAR 'VLA-DELETE dlst)
 )
      )
    )
    (IF regs
      (PROGN
 (SETQ
  expl (APPEND (VLAX-INVOKE (CAR regs) 'Explode)
       (CDR regs)
       )
 )
 (VLA-DELETE (CAR regs))
      )
      (SETQ expl nil)
    )
  )
 )
 (princ "\n No se creo la polilinea")
      )
      (VLA-ENDUNDOMARK *acdoc*)
    )
  )
  (SETQ *error* m:err
 m:err nil
  )
  (PRINC)
)