Dessiner une polyligne sur un objet texte

[fabcad]

Bonjour,

Je sollicite les programmeurs :-)

 

SVP :-) je souhaiterai un programme Lisp/VLisp qui travaille au niveau des textuels (textes, mtextes voire attributs de blocs).

 

=== Questions / Paramètres ===

 

- Sélection AutoCAD classique (par choix des objets) avec comme filtre les textuels.

 

=== Traitement ===

Dans une routine globale : parcourir les textuels et sur chaque textuel :

 

Travail 1 - Dessiner une polyligne depuis le milieu gauche du textuel vers le milieu droite du textuel avec l'angle du textuel.

 

Ces polylignes seraient identifiées dans un calque temporaire afin de ...

 

... Dessiner un point à l'intersection où les polylignes du calque temporaire se croisent.

 

Le but étant de trouver les enchevêtrements de textuels et les polylignes sont conservées pour avoir une base de filaires de voies.

 

Merci d'avance de votre aide,

 

[Edité le 12/2/2010 par fabcad]

[fabcad]

Voici un début de code mais je ne sais pas comment soit en vlisp soit les codes DXF récupérer la distance en unités de la largeur du texte.

 

(defun c:text2line ()
;;; Chargement de la bibliothèque Vlisp
(vl-load-com)

;;; Pointage d'une entité texte AutoCAD et conversion de celle-ci en objet vlisp
(setq ovj(vlax-ename->vla-object(car(entsel))))

;;; création d'un tableau pour le point d'insertion du textuel
(setq ins(vlax-safearray->list (vlax-variant-value (vla-get-Insertionpoint ovj))))

;;; Récupération de l'angle du textuel
(setq rot(vla-get-rotation ovj))

;;; création d'un point par rapport au point d'insertion avec une distance de 50 unités et l'angle du texte
(setq ou2(polar ins rot 50))

(setq pt1 (vlax-3d-point ins))
(setq pt2 (vlax-3d-point ou2))

;;; Récupération des objets non graphiques d'AutoCAD
(setq doc(vla-get-ActiveDocument(vlax-get-acad-object)))
(setq *ModelSpace*(vla-get-ModelSpace doc))

;;; Ajout de la ligne
(vla-addLine *ModelSpace* pt1 pt2 )

);fin defun

 

[CADZEB]

Bonjour,

 

regarde du côté de chez Gile . Le but étant de mettre un cadre autour d'un texte sélectionné, ce qui à l'air de correspondre plus ou moins à ce que tu cherches à faire.

 

Amicalement

Vincent

 

[fabcad]

Merci,

 

J'ai lu la routine mais aie aie les transformations vectorielles !

 

To be continued...

 

Merci quand même.

 

Fabrice

 

 

[fabcad]

Bonjour à tous,

 

J'ai trouvé la solution grâce à Lee Mac sur le site The Swamp voici le lien pour la copie d'écran du C.D.C. et le code :

 

Lien : http://www.theswamp.org/index.php?topic=38008.0

 

(defun c:Pline_over_text ( / ss i e l )
 (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i)))
           l (entget e)
     )
     (entmakex
       (append
         (list
           (cons 0 "LWPOLYLINE")
           (cons 100 "AcDbEntity")
           (cons 100 "AcDbPolyline")
           (assoc 8 l)
           (cons 90 4)
           (cons 70 1)
           (cons 38 (caddr (cdr (assoc 10 l))))
           (assoc 210 l)
         )
         (mapcar '(lambda ( x ) (cons 10 x)) (LM:Strikethrough e))
       )
     )
   )
 )
 (princ)
)
(defun LM:Strikethrough ( e / dx a b h l m n o p r tb w y )
 ;; © Lee Mac 2011
 (defun dx ( x l ) (cdr (assoc x l)))
 (if
   (setq l
     (cond
       (
         (eq "TEXT" (dx 0 (setq e (entget e))))
         (setq b  (dx 10 e)
               r  (dx 50 e)
               tb (textbox e)
               y  (/ (+ (cadar tb) (cadadr tb)) 2.)
         )        
         (list (list (caar  tb) y) (list (caadr tb) y))
       )
       (
         (eq "MTEXT" (dx 0 e))
         (setq n (dx 210 e)
               b (trans (dx 10 e) 0 n)
               r (angle '(0. 0. 0.) (trans (dx 11 e) 0 n))
               w (dx 42 e)
               h (dx 43 e)
               a (dx 71 e)
         )
         (setq h
           (cond
             ( (member a '(1 2 3)) (/ h -2.) )
             ( (member a '(4 5 6)) 0. )
             ( (/ h 2.) )
           )
         )
         (setq o
           (cond
             ( (member a '(2 5 8)) (/ w -2.) )
             ( (member a '(3 6 9)) (- w) )
             ( 0. )
           )
         )
         (list (list o h) (list (+ o w) h))
       )
     )
   )
   (progn
     (setq m 
       (list
         (list (cos r) (sin (- r)) 0.)
         (list (sin r) (cos    r)  0.)
         (list   0.        0.      1.)
       )
       b (reverse (cdr (reverse b)))
     )
     (mapcar
       (function
         (lambda ( p )
           (mapcar '+
             (mapcar
               (function
                 (lambda ( x ) (apply '+ (mapcar '* x p)))
               )
               m
             )
             b
           )
         )
       )
       l
     )
   )
 )
)

 

[Edité le 21/4/2011 par fabcad]

[lecrabe]

 

Hello Fab

 

Sympa ton petit Lisp, j'ai teste sur MAP 2010 32 bits :)

 

Je vois une 2eme utilite un peu "space" :

 

Si tous les textes ont a peu pres la meme longueur physique :

avec une selection globale de toutes ces petites polylignes

+ la bonne largeur globale

+ la bonne couleur forcee

puis mettre en arriere plan

 

et ainsi j'ai un joli rectangle de couleur derriere mes textes !

 

Bon d'accord j'ai une autre routine Lisp qui fait le boulot (avec une polyligne rectangle + hachure Solid) qui fait le boulot !

 

Sans parler des masques sur les MTextes !?

 

Le Decapode

 

 

[fabcad]

Hello Mon cher Décapode,

 

Cette routine va me permettre de créer des amorces de filaires de voies en récupérant l'index du textuel et en le mettant dans un champ de donnée d'objet (AutoCAD MAP) ou bien dans une valeur XDATA.

 

A+