Foro de Arquitectura, Diseño y Construcción


    RUTINA LISP QUE HAGA TEXTO ALINEADO A POLILINEA

    Comparte

    alel
    Primeros mensajes
    Primeros mensajes

    Cantidad de envíos : 4
    Edad : 57
    Localización : Santiago del Estero
    Empleo /Ocio : Arquitecto
    Fecha de inscripción : 31/01/2009

    RUTINA LISP QUE HAGA TEXTO ALINEADO A POLILINEA

    Mensaje por alel el Lun Feb 23, 2009 4:10 pm

    QUIERO LOGRAR UNA RUTINA LISP QUE HAGA UN TEXTO ALINEADO A UNA PLINE, TENGA LA FORMA QUE TENGA. PUEDO
    SELECCIONAR EN AUTOCAD ALGO ASÍ COMO DIGITAR _SELECT _NEAREST...?
    CREERIA QUE CON SSGET ....NO SÉ SI ES ASÍ..!, EXISTE ALGUNA RUTINA QUE LO HAGA?

    prexem
    Administrador
    Administrador

    Cantidad de envíos : 25
    Edad : 51
    Localización : Tucumán - Argentina.
    Empleo /Ocio : Arquitecto Cadista.
    Fecha de inscripción : 10/01/2009

    frase siguiendo una pline, rutina lisp:

    Mensaje por prexem el Lun Feb 23, 2009 4:30 pm

    Tengo esta rutina del 2008, que hace eso justamente, comando "fsigpl":

    Supongamos que necesito escribir una frase cualquiera

    siguiendo una curva dada, entonces dibujo un objeto
    lineal que me sirva de eje, el cual lo pedirá la rutina,
    y luego queda solo el texto curvado y borra el eje:

    Código de la rutina:

    Código:
    ;|*********************************************
              Rutina "fsigpl" frase que sigue
              la curva de un objeto lineal........
      *********************************************
      by (c) Prexem Victor Adolfo Bracamonte 2008
      *********************************************
      --------    www.prexem.blogspot.com  -------
      *********************************************|;
    (prompt
      "\n****La rutina requiere
      \nun objeto lineal para eje del texto\n*****"
    )
    (defun bloqtextinmeasure (/      capa_ant  alt
        frase      cant_espacios
        plineb      osmant  picant
        vla_plineb  pt  long_plineb
        separac    ent_text  cont
        dat_text    pt_inic  ang_rotac
        ang_rotac_text  caract
        eras
        )
      (vl-load-com)
      (setq capa_ant (getvar 'clayer))
      (command "_layer" "_m" "c-ap" "_c" "1" "c-ap" "")
      (setq alt      (getdist "\naltura de texto:")
     frase
            (getstring t
      "\nFrase a escribir en curva:"
            )
     cant_espacios (strlen frase)
      )
      (setvar "clayer" "c-ap")
      (setq plineb
      (car
        (entsel
          "\nSeleccione polilinea u objeto lineal base:"
          )
      )
      )
      (setq osmant (getvar "osmode"))
      (setvar 'osmode 0)
      (setq picant (getvar "pickbox"))
      (setvar 'pickbox 0)
      (setq vla_plineb  (vlax-ename->vla-object plineb)
     pt    (vlax-curve-getstartpoint vla_plineb)
     long_plineb
          (vlax-curve-getdistatparam
            vla_plineb
            (vlax-curve-getendparam vla_plineb)
          )
     separac    (/ long_plineb cant_espacios)
      )
      (command "_text" pt alt "0" "b1")
      (command "_block" "c-ap" pt (entlast) "")
      (setq ent_text (entlast))
      (command "_measure" plineb "b" "c-ap" "_Y" separac)
      (setvar "clayer" capa_ant)
      (setq cont 0)
      (repeat cant_espacios
        (setq ent_text (entnext ent_text)
      dat_text (entget ent_text)
        )
        (setq pt_inic  (cdr (assoc 10 dat_text))
      ang_rotac  (cdr (assoc 50 dat_text))
      ang_rotac_text (angtos ang_rotac 2 2)
      caract  (substr frase (+ cont 1) 1)
        )
        (command "_.text" pt_inic alt ang_rotac_text caract)
        (setq cont (+ cont 1))
      );repeat
      (setq eras
      (ssget "_X"
      (list
        (cons 0 "INSERT")
        (cons 8 "c-ap")
      )
      )
      )
      (command "_erase" eras "")
      (command "_erase" plineb "")
      (command "_laydel" "_n" "c-ap" "" "_Y")
      (command "_purge" "_A" "*" "_N")
      (setvar 'osmode osmant)
      (setvar 'pickbox picant)
      (princ)
    );defun
    (defun err1 (m)
      (progn
        (prompt "*Fin de la aplicacion*")
        (setvar 'osmode osmant)
        (setvar 'pickbox picant)
        (princ)
      )
    )
    (defun c:fsigpl (/ errant *error*)
      (setq errant *error*
     *error* err1
      )
      (bloqtextinmeasure)
      (setq *error* errant)
      (princ)
    )
    Cool


    Última edición por prexem el Lun Feb 23, 2009 4:34 pm, editado 1 vez (Razón : poner más)


    _________________
    *EL BLOG DE PREXEM: www.prexem.blogspot.com

    Verdad es ver el objeto, Realidad es el objeto, Libertad es conocer el objeto........

      Fecha y hora actual: Vie Dic 09, 2016 10:58 pm