Texto a Bloque Atributo
3 participantes
Página 1 de 1.
Texto a Bloque Atributo
Buenos dias, estuve buscando y parece que aca me podrian ayudar, no domino mucho el tema de como hacer una rutina por eso espero me puedan ayudar con alguna rutina que pueda hacer esto.
Tengo unos textos y multitextos, y necesito pasarlo a bloque, como el modelo que os envio.
He visto que no se puede adjuntar , por eso lo envio por la nube, https:// drive.google.com/file/d/0B3HBbf2wcY4nR0FGZWVPZ2hEc0k/view?usp=sharing ojala chicos pueda contar con su ayudita....
Tengo unos textos y multitextos, y necesito pasarlo a bloque, como el modelo que os envio.
He visto que no se puede adjuntar , por eso lo envio por la nube, https:// drive.google.com/file/d/0B3HBbf2wcY4nR0FGZWVPZ2hEc0k/view?usp=sharing ojala chicos pueda contar con su ayudita....
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Hola SushyM, espero que esto te sirva, es un codigo muy viejito, ojalá y funcione bien.
Saludos
- Código:
;Tip1791: TXT2ATTDEF.LSP TEXT TO ATTRIBUTES (c)2002, Sanjay Kulkarni
(defun
C:TXT2ATTDEF ()
(setq PCMDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq TXT1 (entget (car (entsel "\nSelect Text : "))))
(setq IFTXT (cdr (assoc 0 TXT1)))
(while (/= IFTXT "TEXT")
(setq
TXT1
(entget
(car
(entsel
(strcat
"\nSelection Error !! You selected "
IFTXT
"! \nPlease Select Text : "
) ;_ end of strcat
) ;_ end of entsel
) ;_ end of car
) ;_ end of entget
) ;_ end of setq
(setq IFTXT (cdr (assoc 0 TXT1)))
) ;_ end of while
(setq TXT1VAL (cdr (assoc 1 TXT1)))
(setq TXT1IP (cdr (assoc 10 TXT1)))
(setq TXT1HT (cdr (assoc 40 TXT1)))
(setq TXT1ROT (cdr (assoc 50 TXT1)))
(setq APRMPT (getstring T "\nAttribute prompt : "))
(entdel (cdar TXT1))
(setq PAFLAGS (getvar "AFLAGS"))
(setvar "AFLAGS" 0)
(command
"attdef"
""
TXT1VAL
APRMPT
TXT1VAL
TXT1IP
TXT1HT
(/ (* TXT1ROT 180) (/ 22.0 7.0))
) ;_ end of command
(setvar "AFLAGS" PAFLAGS)
;;(alert "\n\t(c) 2000 SanganakSakha \n\tSanganakSakha@ivillage.com")
(setvar "CMDECHO" PCMDECHO)
(princ)
) ;defun txt2attdef
(alert
"\t\t* AutoCAD 14 & AutoCAD 2000/2000i/2002 *\n\n\nThis routine converts the selected string to an attribute definition. \n\nTag and Default value of the new attribute are the same as the string being converted. \n\nThe new Attribute definition by default will be with ICVP value 'NNNN'. \n\nYou can change any/all attributes of this attdef subsequently using 'ddmodify' command. \n\n\nType 'txt2attdef' to execute.\n\n"
) ;_ end of alert
;;End Of Routine
Saludos
saulo2016- Mensajes : 210
Fecha de inscripción : 17/03/2016
Edad : 58
Localización : Monterrey, Nuevo León, Mexico
Re: Texto a Bloque Atributo
Hola, gracias por tu apoyo, parece que hay problema ya que como tengo la version 2018 del autocad y me da un mensaje y no se si se ejecute bien.
Mi idea es tener dos tipos de bloques, uno para texto simple y otro para multitexto,
Text: El bloque 01 debe ser el mismo solo donde cambiaria es el contenido del atributo
Mtext: El bloque 02 debe ser el mismo solo donde cambiaria es el contenido del atributo.
Gracias.
Mi idea es tener dos tipos de bloques, uno para texto simple y otro para multitexto,
Text: El bloque 01 debe ser el mismo solo donde cambiaria es el contenido del atributo
Mtext: El bloque 02 debe ser el mismo solo donde cambiaria es el contenido del atributo.
Gracias.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Hello , que tal
He buscado por la web, pero no he tenido suerte en encotrar algo que me ayude a convertirlos, ojala si pueden este fin de semana me dan esa gran ayuda que necesito chicos.
He buscado por la web, pero no he tenido suerte en encotrar algo que me ayude a convertirlos, ojala si pueden este fin de semana me dan esa gran ayuda que necesito chicos.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Mi máquina con acad14 32 dice que el archivo esta corrupto y cuando lo recupero me salen solo dos círculos que no contienen texto alguno
Igual le pasa a los demás lo mismo.....
Un saludo
Igual le pasa a los demás lo mismo.....
Un saludo
nolo- Mensajes : 182
Fecha de inscripción : 17/03/2016
Re: Texto a Bloque Atributo
Lo he grabado con otra version mas anterior
https:// drive.google.com/open?id=0B3HBbf2wcY4nb1VfQkpZYjBZeVE
Ahora si deberia abrir.
:-)
https:// drive.google.com/open?id=0B3HBbf2wcY4nb1VfQkpZYjBZeVE
Ahora si deberia abrir.
:-)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Encontre una rutina, lo convierte el texto en bloque pero el resultado, el bloque lo rota y lo deja horizontal.
- Código:
; Convierte texto en atributo de bloque.
; Program by Tony Hotchkiss
(defun dxf (code ename) (cdr (assoc code (entget ename))))
(defun make-attributes (ss blockname / i tmsg pmsg t-str p-str en ins-pt txt-ht txt-str txt-style lyr btble)
(setq i (- 1)
tmsg "\nSolicitud: "
pmsg (strcat "\nAtributo sin nombrte" " devuelve el mismo que el identificador: ")
t-str (getstring tmsg)
p-str (getstring t pmsg)
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ins-pt (dxf 10 en)
txt-ht (dxf 40 en)
txt-str (dxf 1 en)
txt-style (dxf 7 en)
lyr (dxf 8 en)
)
(setq btble (tblsearch "BLOCK" blockname))
(if (= btble nil)
(progn (entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockBegin")
(cons 2 blockname)
'(70 . 2)
(cons 10 ins-pt)
)
)
(entmake (list '(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
'(1 . "")
(cons 7 txt-style)
'(100 . "AcDbAttributeDefinition")
(cons 3 p-str)
(cons 2 (strcase t-str))
'(70 . 0)
)
)
(setq bname (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockEnd"))))
)
)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 bname)
(cons 10 ins-pt)
)
)
(entmake (list '(0 . "ATTRIB")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
(cons 1 txt-str)
(cons 7 txt-style)
'(100 . "AcDbAttribute")
(cons 2 t-str)
'(70 . 0)
)
)
(entmake '((0 . "SEQEND")))
(entdel en)
)
(princ)
)
(defun c:txt_att (/ block-exists blockname btble ss)
(setq block-exists t)
(while block-exists
(setq blockname (getstring "Nombre de bloque: "))
(setq btble (tblsearch "BLOCK" blockname))
(if btble
(progn (setq block-exists t) (prompt "\nNombre de bloque existente, Enter "))
(progn (setq block-exists nil))
)
)
(setq ss nil)
(prompt "\nSeleccionar texto: ")
(while (= ss nil)
(setq ss (ssget '((0 . "TEXT"))))
(if (= ss nil)
(prompt "\nNingun texto seleccionado, Seleccionar texto: ")
)
)
(if ss
(progn (make-attributes ss blockname))
)
)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Se deberia dejar el bloque igual al angulo de rotacion del Texto, pero no sirve para Mtext
:-)
:-)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Bueno Sushy, ahora si lo he podido cargar ...
Al código que subiste de Tony Hotchkiss solo le falta recuperar el código 50 del texto y ponérselo al atributo en la subfunción principal
Aquí te la dejo corregida para que no tengas que pensar
Respecto a la posibilidad de que trate también multitextos, dada la gran variedad de colores, marcadores, líneas de texto, etc que pueden albergar, llevaría mucho tiempo y sería complicadillo meterse con ello.
Lo que si se puede hacer es resolver el caso concreto que tu has propuesto en tu dibujo modelo, es decir, fijar constantes la altura de texto, el número de líneas y el tipo de letra como en tu ejemplo.
Siguiendo la mecánica de la rutina de Tony solo habría que añadir los multitextos a la selección de ssget, crear una lista de atributos por cada línea y separarlos en altura a la hora de su inserción, con un porcentaje de la altura del texto. Vamos, como sigue :
Si cambias el número de líneas del texto, se mantendrá que el punto de inserción esta en la segunda línea y si cambias tipo de letra tendras que ajustar el valor de los 0.65 de interlineado que te he señalado. Si el multitexto tiene otros parámetros de color, altura etc Se ignorarán o dará resultados extraños.
Espero te sirva ....
Un saludo
Al código que subiste de Tony Hotchkiss solo le falta recuperar el código 50 del texto y ponérselo al atributo en la subfunción principal
Aquí te la dejo corregida para que no tengas que pensar
- Código:
(defun make-attributes (ss blockname / rot i tmsg pmsg t-str p-str en ins-pt txt-ht txt-str txt-style lyr btble)
(setq i (- 1)
tmsg "\nSolicitud: "
pmsg (strcat "\nAtributo sin nombrte" " devuelve el mismo que el identificador: ")
t-str (getstring tmsg)
p-str (getstring t pmsg)
)
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ins-pt (dxf 10 en)
txt-ht (dxf 40 en)
txt-str (dxf 1 en)
txt-style (dxf 7 en)
lyr (dxf 8 en)
rot (dxf 50 en);;; <----
)
(setq btble (tblsearch "BLOCK" blockname))
(if (= btble nil)
(progn (entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockBegin")
(cons 2 blockname)
'(70 . 2)
(cons 10 ins-pt)
)
)
(entmake (list '(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
'(1 . "")
(cons 7 txt-style)
'(100 . "AcDbAttributeDefinition")
(cons 3 p-str)
(cons 2 (strcase t-str))
'(70 . 0)
)
)
(setq bname (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockEnd"))))
)
)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 bname)
(cons 10 ins-pt)
)
)
(entmake (list '(0 . "ATTRIB")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
(cons 1 txt-str)
(cons 7 txt-style)
(cons 50 rot) ;;; <----
'(100 . "AcDbAttribute")
(cons 2 t-str)
'(70 . 0)
)
)
(entmake '((0 . "SEQEND")))
(entdel en)
)
(princ)
)
Respecto a la posibilidad de que trate también multitextos, dada la gran variedad de colores, marcadores, líneas de texto, etc que pueden albergar, llevaría mucho tiempo y sería complicadillo meterse con ello.
Lo que si se puede hacer es resolver el caso concreto que tu has propuesto en tu dibujo modelo, es decir, fijar constantes la altura de texto, el número de líneas y el tipo de letra como en tu ejemplo.
Siguiendo la mecánica de la rutina de Tony solo habría que añadir los multitextos a la selección de ssget, crear una lista de atributos por cada línea y separarlos en altura a la hora de su inserción, con un porcentaje de la altura del texto. Vamos, como sigue :
- Código:
; Convierte texto en atributo de bloque.
; Program by Tony Hotchkiss
;; añadido ciertos multitextos por Nolo en septiembre 2017
(defun dxf (code ename) (cdr (assoc code (entget ename))))
(defun make-attributes (ss blockname / i n rot txt txtl tmsg pmsg t-str p-str en ins-pt txt-ht txt-str txt-style lyr btble)
(setq i (- 1)
tmsg "\nSolicitud: "
pmsg (strcat "\nAtributo sin nombrte" " devuelve el mismo que el identificador: ")
t-str (getstring tmsg)
p-str (getstring t pmsg)
)
(if (= t-str "") (setq t-str "Dato ")) ;; por si quieres darle al intro sin poner nada
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ins-pt (dxf 10 en)
txt-ht (dxf 40 en)
txt (dxf 1 en) ;;; aqui era txt-str
txt-style (dxf 7 en)
lyr (dxf 8 en)
rot (dxf 50 en);;; <----
n -1
)
(while (wcmatch txt (strcat "*"(chr 10)"*"))
(setq txt (vl-string-subst (strcat (chr 34)")("(chr 34)) (chr 10) txt))
)
(setq txtl (eval(read (strcat "'(("(chr 34) txt (chr 34) ")))"))))
(setq btble (tblsearch "BLOCK" blockname))
(if (= btble nil)
(progn (entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockBegin")
(cons 2 blockname)
'(70 . 2)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
'(1 . "")
(cons 7 txt-style)
'(100 . "AcDbAttributeDefinition")
(cons 3 p-str)
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
)
(setq bname (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockEnd"))))
)
)
(setq n -1)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 bname)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTRIB")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10
(if (>(length txtl) 1)
(polar ins-pt (* 1.5 pi) (* n (getvar 'textsize) 0.65)) ;; 0.65 porcentaje interlineado
ins-pt
))
(cons 40 txt-ht)
(cons 1 (car txt-str))
(cons 7 txt-style)
(cons 50 rot) ;;; <----
'(100 . "AcDbAttribute")
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
); fin foreach
(entmake '((0 . "SEQEND")))
(entdel en)
)
(princ)
)
(defun c:txt_att (/ block-exists blockname btble ss)
(setq block-exists t)
(while block-exists
(setq blockname (getstring "Nombre de bloque: "))
(setq btble (tblsearch "BLOCK" blockname))
(if btble
(progn (setq block-exists t) (prompt "\nNombre de bloque existente, Enter "))
(progn (setq block-exists nil))
)
)
(setq ss nil)
(prompt "\nSeleccionar texto: ")
(while (= ss nil)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if (= ss nil)
(prompt "\nNingun texto seleccionado, Seleccionar texto: ")
)
)
(if ss
(progn (make-attributes ss blockname))
)
)
Si cambias el número de líneas del texto, se mantendrá que el punto de inserción esta en la segunda línea y si cambias tipo de letra tendras que ajustar el valor de los 0.65 de interlineado que te he señalado. Si el multitexto tiene otros parámetros de color, altura etc Se ignorarán o dará resultados extraños.
Espero te sirva ....
Un saludo
nolo- Mensajes : 182
Fecha de inscripción : 17/03/2016
Re: Texto a Bloque Atributo
Hola, nolo, gracias por el tiempo tomado, he podido revizar y para lo que necesito funciona. Esta rutina me ayudara mucho en lo que estoy haciendo.
Una consulta si el MText que puse de ejemplo, tenia 3 filas de texto ahora tuviera cuatro filas. que tendria que adicionar a la rutina para que me genere el bloque con 4 atributos.
Igual muchas gracias por todo el apoyo obtenido.
:-)
Una consulta si el MText que puse de ejemplo, tenia 3 filas de texto ahora tuviera cuatro filas. que tendria que adicionar a la rutina para que me genere el bloque con 4 atributos.
Igual muchas gracias por todo el apoyo obtenido.
:-)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Hola nolo, te hago una consulta adicional, https:// drive.google.com/open?id=0B3HBbf2wcY4naXNCb3BHcE8tTms
Ojala puedas verlo, ya que si bien es cierto el bloque queda rotado pero ese angulo no lo ingresa al bloque.
Gracias.
Ojala puedas verlo, ya que si bien es cierto el bloque queda rotado pero ese angulo no lo ingresa al bloque.
Gracias.
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Los atributos tiene rotación y punto de inserción independente del bloque por lo que aunque el bloque este girado xº cuando insertas el atributo hay que ponerle su propia rotación. Una vez insertado, al girar el bloque girara con el.
Es otro procedimiento que se podía haber sequido, insertar en horizontal (tal como estaba) y luego girar el bloque insertado, pero es mas fácil hacerlo de una vez.
La rutina insertará tantos atributos en el bloque como líneas, lo único es que no mantendrá el punto de inserción del texto como referencia y moverá los atributos de forma que quedaran desplazados respecto a la situación original de los textos.
Estos puntos de inserción se pueden corregir en la función polar de las líneas que ponen
Cambiando el if por un condicional que dependa del número de línea n según de la longitud de la lista de textos txtl o una función mas compleja dependiendo del boundinboox del texto.
Eso te lo dejo para que hagas pruebas y así iras aprendiendo ...
Un saludo
Es otro procedimiento que se podía haber sequido, insertar en horizontal (tal como estaba) y luego girar el bloque insertado, pero es mas fácil hacerlo de una vez.
La rutina insertará tantos atributos en el bloque como líneas, lo único es que no mantendrá el punto de inserción del texto como referencia y moverá los atributos de forma que quedaran desplazados respecto a la situación original de los textos.
Estos puntos de inserción se pueden corregir en la función polar de las líneas que ponen
- Código:
(cons 10
(if (>(length txtl) 1)
(polar ins-pt (* 1.5 pi) (* n (getvar 'textsize) 0.65)) ;; 0.65 serparación
ins-pt
))
Cambiando el if por un condicional que dependa del número de línea n según de la longitud de la lista de textos txtl o una función mas compleja dependiendo del boundinboox del texto.
Eso te lo dejo para que hagas pruebas y así iras aprendiendo ...
Un saludo
nolo- Mensajes : 182
Fecha de inscripción : 17/03/2016
Re: Texto a Bloque Atributo
Segun Esto "Los atributos tiene rotación y punto de inserción independente del bloque por lo que aunque el bloque este girado xº cuando insertas el atributo hay que ponerle su propia rotación. Una vez insertado, al girar el bloque girara con el.
Es otro procedimiento que se podía haber sequido, insertar en horizontal (tal como estaba) y luego girar el bloque insertado, pero es mas fácil hacerlo de una vez."
No hay ninguna otra opcion de poder poner el angulo de rotacion, ya que al editar el bloque y synchronize todos los bloques se ponen horizontal.
Ojala puedas apoyarme en esta ultima parte . Gracias ;-)
Es otro procedimiento que se podía haber sequido, insertar en horizontal (tal como estaba) y luego girar el bloque insertado, pero es mas fácil hacerlo de una vez."
No hay ninguna otra opcion de poder poner el angulo de rotacion, ya que al editar el bloque y synchronize todos los bloques se ponen horizontal.
Ojala puedas apoyarme en esta ultima parte . Gracias ;-)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Hola, no se lo que quieres decir con - editar el bloque y synchronize -
Con el doble clip a mi me aparece el editor de atributos en los bloques con atributos, y tiene sus propias casillas para la rotación
Para girar el bloque después de insertado, esta sería la modificación de la rutina
Un saludo
Con el doble clip a mi me aparece el editor de atributos en los bloques con atributos, y tiene sus propias casillas para la rotación
Para girar el bloque después de insertado, esta sería la modificación de la rutina
- Código:
(defun make-attributes (ss blockname / i n txt txtl tmsg pmsg t-str p-str en ins-pt txt-ht txt-str txt-style lyr btble);;;rot
(setq i (- 1)
tmsg "\nSolicitud: "
pmsg (strcat "\nAtributo sin nombrte" " devuelve el mismo que el identificador: ")
t-str (getstring tmsg)
p-str (getstring t pmsg)
)
(if (= t-str "") (setq t-str "Dato "))
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ins-pt (dxf 10 en)
txt-ht (dxf 40 en)
txt (dxf 1 en) ;;; aqui era txt-str
txt-style (dxf 7 en)
lyr (dxf 8 en)
rot (dxf 50 en);;; <----
n -1
)
(while (wcmatch txt (strcat "*"(chr 10)"*"))
(setq txt (vl-string-subst (strcat (chr 34)")("(chr 34)) (chr 10) txt))
)
(setq txtl (eval(read (strcat "'(("(chr 34) txt (chr 34) ")))"))))
(setq btble (tblsearch "BLOCK" blockname))
(if (= btble nil)
(progn (entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockBegin")
(cons 2 blockname)
'(70 . 2)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
'(1 . "")
(cons 7 txt-style)
'(100 . "AcDbAttributeDefinition")
(cons 3 p-str)
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
)
(setq bname (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockEnd"))))
)
)
(setq n -1)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 bname)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTRIB")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10
(if (>(length txtl) 1)
(polar ins-pt (* 1.5 pi) (* n (getvar 'textsize) 0.65)) ;; 0.65 serparación
ins-pt
))
(cons 40 txt-ht)
(cons 1 (car txt-str))
(cons 7 txt-style)
;;;(cons 50 rot) ;;; <----
'(100 . "AcDbAttribute")
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
); fin foreach
(entmake '((0 . "SEQEND")))
(entdel en)
;; rotación al bloque
(setq obl (vlax-ename->vla-object (entlast)))
(VLA-PUT-ROTATION obl rot)
)
(princ)
)
Un saludo
nolo- Mensajes : 182
Fecha de inscripción : 17/03/2016
Re: Texto a Bloque Atributo
Hola amigo, disculpa todavia no se mucho de programar, pero como enlazo este ultimo codigo con el anterior.
Para poder ejecutarlo.
Gracias
Para poder ejecutarlo.
Gracias
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Re: Texto a Bloque Atributo
Solo tienes que cambiar la función make-atributes antigua por la nueva de mi anterior post.
Entre el (defun make-attributes etc ....
y el
(princ)
)
Así sería el cambio
Un saludo
Entre el (defun make-attributes etc ....
y el
(princ)
)
Así sería el cambio
- Código:
; Convierte texto en atributo de bloque.
; Program by Tony Hotchkiss
;; añadido ciertos multitextos por Nolo en septiembre 2017
(defun dxf (code ename) (cdr (assoc code (entget ename))))
(defun make-attributes (ss blockname / i n txt txtl tmsg pmsg t-str p-str en ins-pt txt-ht txt-str txt-style lyr btble);;;rot
(setq i (- 1)
tmsg "\nSolicitud: "
pmsg (strcat "\nAtributo sin nombrte" " devuelve el mismo que el identificador: ")
t-str (getstring tmsg)
p-str (getstring t pmsg)
)
(if (= t-str "") (setq t-str "Dato "))
(repeat (sslength ss)
(setq en (ssname ss (setq i (1+ i)))
ins-pt (dxf 10 en)
txt-ht (dxf 40 en)
txt (dxf 1 en) ;;; aqui era txt-str
txt-style (dxf 7 en)
lyr (dxf 8 en)
rot (dxf 50 en);;; <----
n -1
)
(while (wcmatch txt (strcat "*"(chr 10)"*"))
(setq txt (vl-string-subst (strcat (chr 34)")("(chr 34)) (chr 10) txt))
)
(setq txtl (eval(read (strcat "'(("(chr 34) txt (chr 34) ")))"))))
(setq btble (tblsearch "BLOCK" blockname))
(if (= btble nil)
(progn (entmake (list '(0 . "BLOCK")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockBegin")
(cons 2 blockname)
'(70 . 2)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTDEF")
'(100 . "AcDbEntity")
'(67 . 0)
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10 ins-pt)
(cons 40 txt-ht)
'(1 . "")
(cons 7 txt-style)
'(100 . "AcDbAttributeDefinition")
(cons 3 p-str)
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
)
(setq bname (entmake (list '(0 . "ENDBLK") '(100 . "AcDbEntity") (cons 8 lyr) '(100 . "AcDbBlockEnd"))))
)
)
(setq n -1)
(entmake (list '(0 . "INSERT")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbBlockReference")
'(66 . 1)
(cons 2 bname)
(cons 10 ins-pt)
)
)
(foreach txt-str txtl
(entmake (list '(0 . "ATTRIB")
'(100 . "AcDbEntity")
(cons 8 lyr)
'(100 . "AcDbText")
(cons 10
(if (>(length txtl) 1)
(polar ins-pt (* 1.5 pi) (* n (getvar 'textsize) 0.65)) ;; 0.65 serparación
ins-pt
))
(cons 40 txt-ht)
(cons 1 (car txt-str))
(cons 7 txt-style)
;;;(cons 50 rot) ;;; <----
'(100 . "AcDbAttribute")
(cons 2 (strcat t-str (itoa (setq n (1+ n)))))
'(70 . 0)
)
)
); fin foreach
(entmake '((0 . "SEQEND")))
(entdel en)
;; rotación al bloque
(setq obl (vlax-ename->vla-object (entlast)))
(VLA-PUT-ROTATION obl rot)
)
(princ)
)
(defun c:txt_att (/ block-exists blockname btble ss)
(setq block-exists t)
(while block-exists
(setq blockname (getstring "Nombre de bloque: "))
(setq btble (tblsearch "BLOCK" blockname))
(if btble
(progn (setq block-exists t) (prompt "\nNombre de bloque existente, Enter "))
(progn (setq block-exists nil))
)
)
(setq ss nil)
(prompt "\nSeleccionar texto: ")
(while (= ss nil)
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if (= ss nil)
(prompt "\nNingun texto seleccionado, Seleccionar texto: ")
)
)
(if ss
(progn (make-attributes ss blockname))
)
)
Un saludo
nolo- Mensajes : 182
Fecha de inscripción : 17/03/2016
Re: Texto a Bloque Atributo
Muchas Gracias amigo nolo. Funciona a la perfeccion.
;-)
;-)
SushyM- Mensajes : 38
Fecha de inscripción : 13/09/2017
Temas similares
» Bloque con atributo e identificador duplicados
» Bloque Numerado
» Seleccion Bloques Intersectados
» incluir un bloque en un archivo VLX
» Insertar un bloque y centrarlo
» Bloque Numerado
» Seleccion Bloques Intersectados
» incluir un bloque en un archivo VLX
» Insertar un bloque y centrarlo
Página 1 de 1.
Permisos de este foro:
No puedes responder a temas en este foro.
|
|