Texto a Polilínea o curvas o lo que sea.
Página 1 de 1.
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.
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.
eliasp- Mensajes : 101
Fecha de inscripción : 17/03/2016
Re: Texto a Polilínea o curvas o lo que sea.
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)
Luis Alberto Benitez- Mensajes : 83
Fecha de inscripción : 29/03/2016
Re: Texto a Polilínea o curvas o lo que sea.
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,
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,
eliasp- Mensajes : 101
Fecha de inscripción : 17/03/2016
Re: Texto a Polilínea o curvas o lo que sea.
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)
)
Marco Jacinto- Mensajes : 80
Fecha de inscripción : 12/08/2016
Página 1 de 1.
Permisos de este foro:
No puedes responder a temas en este foro.
|
|