26 mar 2008

Comando "fsigpl": para escribir un texto o frase siguiendo la curvatura de un objeto lineal de base.

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:




;|*********************************************
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)
)

No hay comentarios: