encercle texte

[sechanbask]

Bonjour,

Je cherche un lisp du genre "enclose text with objet" des express tools mais j'aimerais qu'il m'entoure le texte avec un objet du calque de l'objet(et non du calque courant). Et en plus j'aimerais qu'il soit sur l'objet rectangle par défaut (et non sur cercle)...

[capde06]

eszsai celui la

 

 

 

 

(defun c:tbox ()

(setq ecart 0.3);;ecart autour du texte

(setq ent (car (entsel "\nSelection du texte ")))

(if (= "TEXT" (cdr (assoc 0 (entget ent))))

(progn

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(setvar "cmdecho" 0)

(SETQ ECART (/ (CDR (ASSOC 40 (ENTGET ENT))) 2))

(setq tb (cadr (textbox (entget ent))))

(command "scu" "ob" ent)

(command "_rectang"

(list (- ecart) (- ecart))

(list (+ ecart (car tb)) (+ ecart (cadr tb)))

) ;_ Fin de command

(setq a (entget (entlast)))

(entmod

(subst (cons 8 (cdr (assoc 8 (entget ent))))

(assoc 8 a)

a

) ;_ Fin de subst

) ;_ Fin de entmod

(command "scu" "p")

(setvar "osmode" oldos)

) ;_ Fin de progn

(princ

(strcat "\nEntitee est une "

(cdr (assoc 0 (entget ent)))

) ;_ Fin de strcat

) ;_ Fin de princ

 

) ;_ Fin de if

(princ)

) ;_ Fin de defun

[sechanbask]

merci beaucoup c'est possible pour les mtext???

[zebulon_]

bonjour,

Il y a tout ce qu'il faut dans les express tools.

 

Regarde un peu de plus près le fichier acettxt.lsp dans le répertoire des express tools. Dans ce fichier, tu trouveras la fonction (c:tcircle) qui est la commande lancée par le menu express.

Elle ne nous intéresse que moyennement, puisqu'elle n'a pas de paramètres. Par contre, vers la fin de cette fonction, on voit qu'elle en appelle une autre :

 

(defun bns_tcircle ( ss rad ent slot offset)

....

)

 

qui, elle, est paramétrable.

 

Il suffirait donc de faire quelque chose comme ça :

 

(defun c:mytcircle (/ ss)
 (setq ss (ssget '((-4 . "< OR") (0 . "TEXT") (0 . "ATTDEF") (0 . "MTEXT") (-4 . "OR>"))) )
 ;; charger la fonction si elle ne l'est pas
 (if (not bns_tcircle) (load "acettxt.lsp"))
 (bns_tcircle ss "Variable" "Rectangles" nil 0.5)
)

 

PS 1 : il faut enlever l'espace entre "< et OR, sinon ça ne marche pas.

PS 2 : par contre, les auteurs de ce lisp n'ont pas prévu de paramétrer le calque et c'est bien dommage

 

Amicalement

Zebulon_

 

[BIM G CO]

pour récupérer l'objet ainsi créé un (entlast) suffit :)

[zebulon_]

Bonjour,

 

pour récupérer l'objet ainsi créé un (entlast) suffit 

 

(bns_tcircle ...) fonctionne avec un jeu de sélection et crée autant de cadre que de textes sélectionnés. (entlast) ne suffit donc pas sauf dans le cas où il n'y a qu'un seul objet dans le jeu de sélection.

 

Amicalement

Zebulon_

 

[BIM G CO]

avant la fonction (bns_circle...) tu effectue une (entlast) dont tu enregistre la valeur dans une variable que je nomme ici VAR_ENTLAST

à la suite du (bns_circle ....) tu suis les éléments ainsi créé à partir de la variable VARè_ENTLAST jusque au (entlast) par des (entnext)

 

J'effectue cette opération pour corriger les bugs de FISACAD de Fauconnet Ingénierie.

[zebulon_]

Re,

 

Effectivement, c'est un moyen. Mais les textes sélectionnés peuvent être sur des calques différents (pourquoi pas ?) et on ne saurait pas lequel prendre.

Il faudrait ruser et remonter parallèlement les (entnext), comme tu le décris, et le jeu de sélection ss, pour mettre chaque cadre sur le calque du texte qu'il encadre.

 

Amicalement

Zebulon_

 

[Bred]

Salut,

Alors je suis un peu dubitatif, car c'est plus compliqué que je n'aurais pensé...

Les express-tool utilise une commande qui leur est propre pour extraire "l'emcombrement" du texte...

acet-geom-textbox

est c'est là difficulté : je n'arrive pas à la reproduire facilement ....

 

Donc, j'ai bidouillé un truc pour faire un rectangle "propre" avec une marge de 10% de la hauteur du texte...

Mais je suis obligé de passer par un (command "_explode" ...), et si le Mtext est sur plusieur ligne, ça ne prends que la dernière ligne .... :mad:

c'est pas simple .... je vais approfondir le truc ...

(la mise sur le calque est le plus simple)

 

(defun c:rectxt (/ A ACDOC B FACT I LAY LST-P LST-VLA-SEL MAXPOINT MINPOINT PLINE PTS SEL TXT)
(setq sel (ssget '((0  . "MTEXT")))
     lst-vla-sel nil
     lst-p nil)

(if (= (getvar "CVPORT") 1)
 (setq AcDoc (vla-get-PaperSpace
	(vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq AcDoc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
)
 

(foreach n (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
    (setq lst-vla-sel (append (list (vlax-ename->vla-object n)) lst-vla-sel))
    )

(repeat (setq i (length lst-vla-sel))
 (setq txt (vla-copy (nth (setq i (1- i)) lst-vla-sel)))
 (command "_explode" (vlax-vla-object->ename txt))
 (setq txt (vlax-ename->vla-object (entlast))
fact (* (vla-get-Height txt) 0.1)
lay (vla-get-layer txt))
 (vla-GetBoundingBox txt 'minpoint 'maxpoint)
 (setq a (vlax-safearray->list minpoint)
b (vlax-safearray->list maxpoint))
 (vla-delete txt)  
 (setq lst-p (append (list (- (car a) fact)(- (cadr a) fact)(caddr a))
	      (list (+ (car b) fact) (- (cadr a) fact) (caddr a))
	      (list (+ (car b) fact)(+ (cadr b) fact)(caddr b))
	      (list (- (car a) fact)(+ (cadr b) fact)(caddr a))
	      )
)	
 (setq pts (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (1- (length lst-p))))lst-p))
pline (vla-add3DPoly AcDoc pts))
 (vla-put-closed pline :vlax-true)
 (vla-put-layer pline lay)
 )
 )

 

 

 

[zebulon_]

Pourquoi es-tu obligé de passer par un explode ?

 

Amicalement

Zebulon_

 

 

[Bred]

Pourquoi es-tu obligé de passer par un explode ?

Pour récupérer l'emcombrement "net" du texte :

J'explose le Mtext et je récupère le GetBoundingBox du texte simple.

Car le GetBoundingBox d'un Mtext est le rectangle formé par les griffes du Mtext, et qui n'est pas forcément l'emprise du Mtext...

et vla-explode ne fonctionne pas sur du mtext ....

 

... c'est clair ? :casstet: :(

[zebulon_]

Très clair. Mais comme moi, je n'utilise que des MTEXT de largeur 0, donc sans griffes (je ne savais pas que ça s'appelait comme ça), je ne comprenais pas.

C'est vrai que ça fait tache le (command _explode...) au milieu du vlisp, mais l'important c'est que ça marche.

 

Amicalement

Zebulon_

 

[Bred]

donc sans griffes (je ne savais pas que ça s'appelait comme ça),

En fait le nom exact est "poignées", c'est par (mauvaise) habitude que j'appel "griffes"....

Bonne remarque !

[bonuscad]

Pour récupérer l'emcombrement "net" du texte

 

Un sujet qui pourra peut être t'aider pour ton problème sur les MTEXT

 

 

Je suis sur que tu vas m'améliorer tout ça de facon élégante ;)

 

[Edité le 30/5/2007 par bonuscad]

[jalna]

En fait le nom exact est "poignées", c'est par (mauvaise) habitude que j'appel "griffes"....

 

Juste un petit mot pour dire que les "poignées" s'appellent aussi "grips" c'est peut etre pour cela les "griffes".

 

Attention ne me les sort pas............... :P

[Bred]

Bonuscad :

 

textbox !!!!

 

Vu ! merci !

(je ne connaissais pas !)

[zebulon_]

En suivant les conseils de Maximilien, ça donne :

 

(defun c:mytcircle (/ ss e I a lay lrect rect lastent)
 (setq ss (ssget '((-4 . "< OR") (0 . "TEXT") (0 . "ATTDEF") (0 . "MTEXT") (-4 . "OR>"))) )
 ;; charger la fonction si elle ne l'est pas
 (if (not bns_tcircle) (load "acettxt.lsp"))
 (setq lastent (entlast))
 (bns_tcircle SS "Variable" "Rectangles" nil 0.5)
 (setq lrect nil)
 (while (setq lastent (entnext lastent))
   (setq lrect (cons lastent lrect))
 )
 (setq lrect (reverse lrect))
 (setq I 0)
 (repeat (sslength ss)
   (setq e (ssname ss I))
   (setq rect (nth I lrect))
   (setq I (+ I 1))
   (setq a (entget e))
   (setq lay (cdr (assoc 8 a)))
   (command "_change" rect "" "_p" "_la" LAY "")
 )
 (princ)
) 

 

C'est une ruse de Sioux, Maximilien ;)

 

Amicalement

Zebulon_

[Bred]

(désolé, je polue un peu le post, mais je tente en parrallèlle de créer une routine pourvant se passer des express-tool...)

Bonuscad :

textbox !!!!

Vu ! merci !

(je ne connaissais pas !)

Je me suis emballer trop vite : textbox ne fonctionne que pour des types "simplex..."

 

... pffff....

[zebulon_]

textbox ne fonctionne que pour des types "simplex..."

 

tu peux aussi regarder ici où on s'était déjà gratté la tête au sujet du get-boundingbox

 

Amicalement

Zebulon_

 

[(gile)]

Je me suis emballer trop vite : textbox ne fonctionne que pour des types "simplex..."

 

pour les textes multiligne, regarde les codes DXF 42 et 43 qui donnent la largeur et la hauteur du texte sans tenir compte des "grips".

[bonuscad]

Oui,

 

C'est bien cela que je voulais faire découvrir à Bred, le code DXF 42 et 43 des Mtext qui donnent la hauteur et la largeur de l'encombrement du texte.

 

Ces dimensions sont par rapport au SCO de l'objet Mtext.

 

Je n'ai jamais eu de problème avec les styles !?!?

 

La version que j'ai pointé est nettement améliorable, les sous-fonctions peuvent être remplacé par des (trans) bien pensé pour obtenir les points de la boite dans le SCG et construire une poly2D ou 3D (si on voulais étendre la fonction à des SCU non parallèles) avec (entmake)

 

Donc je pense qu'aucun appel à "command" est possible.

[Bred]

(gile) est venu....

(gile) à écris ...

(gile) m'a vaincu !!!!

 

merci !

 

Donc, déjà, pour le rectangle :

(écartement de 20% / hauteur du texte)

 

(defun c:rectxt (/ ACDOC FACT HAUT I LARG LAY LST-P PLINE PT PTS SEL)
 
 (if (= (getvar "CVPORT") 1)
 (setq AcDoc (vla-get-PaperSpace
	(vla-get-ActiveDocument (vlax-get-acad-object))))
 (setq AcDoc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
)
 
 (setq sel (ssget '((0 . "MTEXT"))))
 
 (repeat (setq i (sslength sel))
   (setq pt (cdr (assoc 10 (entget (ssname sel (setq i (1- i))))))
  larg (cdr (assoc 42 (entget (ssname sel i))))
  haut (cdr (assoc 43 (entget (ssname sel i))))
  lay (cdr (assoc 8 (entget (ssname sel i))))
  fact (* (cdr (assoc 40 (entget (ssname sel i)))) 0.20)
  lst-p (list
	  (- (car pt) fact)(+ (cadr pt) fact)(caddr pt)
	  (+ (+ (car pt) larg) fact) (+ (cadr pt) fact) (caddr pt)
	  (+ (+ (car pt) larg) fact) (- (- (cadr pt) haut) fact) (caddr pt)
	  (- (car pt) fact) (- (- (cadr pt) haut) fact) (caddr pt))
  pts (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (1- (length lst-p))))lst-p))
  pline (vla-add3DPoly AcDoc pts))
   (vla-put-closed pline :vlax-true)
   (vla-put-layer pline lay)
   )
 )

 

... et merci à Bonuscad,... je n'ai pas assez approfondis sa proposition !

 

[Edité le 30/5/2007 par Bred]

[(gile)]

Salut,

 

À la place de :

(setq pts (vlax-make-variant (vlax-SafeArray-fill (vlax-make-SafeArray vlax-vbDouble (cons 0 (1- (length lst-p))))lst-p))

pline (vla-add3DPoly AcDoc pts))

 

tu peux simplement faire :

(setq pline (vlax-invoke AcDoc 'add3DPoly p-lst))

 

Sinon, j'ai regardé d'un peu plus près, c'est assez tordu si on veut prendre en compte tous les types de justifications, et aussi les possibles rotations et SCU divers...

[BIM G CO]

zebulon_ tous les coups sont permis pour dompter AutoCAD même tirer la queue du diable

Si çà marche pour réparer les erreurs d'un BE participant à la création d'AutoCAD MEP çà doit marcher pour tout le reste.

[zebulon_]

On va se gêner...

 

Mais faudrait quand même lui dire que son FISACAD ne marche pas bien.

 

Amicalement

Zebulon_