Justification de textuels d'altitudes en fonction de leur point associé

[fabcad]

Bonjour à tous,

 

Je souhaiterais finaliser une fonction qui me permettrait d'agrandir des textes d'altitude en relation avec leur justification.

 

Je voulais faire par l'angle entre le textuel et son ponctuel mais ca ne fonctionnait pas, j'ai dû me résoudre à utiliser la fonction Justifier AutoCAD.

Mais cela m'embête car prendre une fonction AutoCAD, ce n'est pas élégant dans un lisp.

Il y a 4 cas de figure HG, HD, BD, BG pour effectuer le traitement.

 

La routine utilise (merci Gilles) une sous-fonction de sélection circulaire pour sélectionner le texte à proximité d'un point (bloc).

 

La routine fonctionne pour un objet mais pas pour plusieurs points. Je ne vois plus mes erreurs.

 

L'avis des experts se rait la bienvenue.

 

Merci pour votre aide.

 

J'ai joint dans le sujet deux fichiers lisp et l'extrait d'un fichier dwg.

 

Bonne journée,

 

Fabcad,

 

Le Rennais Métropolitain,

dwg-lsp.zip

[bonuscad]

Salut,

 

Je viens de regarder rapidement ton problème.

 

Le gros hic est que tu travailles dans un système de coordonnées élevées et que du utilises un filtre de sélection par "_CP" (Capture Polygone). Ce mode de sélection pour qu'il fonctionne correctement t'oblige à zoomer sur l'endroit où tu veux faire ces sélections: en tout cas c'est mon retour d'expérience...

 

Donc avec ce handicap, le lisp deviendra beaucoup plus lent à l'exécution, mais plus fiable.

 

Sur ton algo, j'ai préféré le prendre en sens inverse de toi.

Je m'explique:

Je cherche tous les textes filtrés que je vais passer en revue un par un.

A ceux-ci je cherche la boite d'encombrement aux quels je vais appliquer la recherche du bloc aux quatre coins de cette boite.

Si la recherche est fructueuse j'applique la justification correspondante au coin du texte.

 

Voici par exemple l'embryon de code pondu à la va vite

 

(defun circsel (cen rad mod fltr / ang lst)
 (setq ang 0)
 (repeat 50
   (setq
     lst (cons (polar cen ang rad) lst)
     ang (+ ang (/ pi 25))
   )
 )
 (ssget mod lst fltr)
)
(defun c:toto ( / js_text n ent_txt ename ll ur l_box l_just js_bl)
 (setvar "CMDECHO" 0)
 (setvar "OSMODE" 0)
 (princ "\nChoix des texte à justfier.")
 (setq js_text (ssget '((0 . "TEXT") (67 . 0) (410 . "Model") (8 . "EA_AL200") (6 . "Continuous") (100 . "AcDbText"))))
 (cond
   (js_text
     (repeat (setq n (sslength js_text))
       (setq ename (vlax-ename->vla-object (setq ent_txt (ssname js_text (setq n (1- n))))))
       (vla-GetBoundingBox ename 'll 'ur)
       (setq
         ll (safearray-value ll)
         ur (safearray-value ur)
       )
       (setq l_box (list ll (list (car ll) (cadr ur) 0.0) ur (list (car ur) (cadr ll) 0.0)) l_just '("_BL" "_TL" "_TR" "_BR"))
       (command "_.zoom" "_window" ll ur)
       (command "_.zoom" "0.5x")
       (repeat 4
         (setq js_bl (circsel (car l_box) 0.2 "_CP" '((0 . "INSERT") (67 . 0) (410 . "Model") (8 . "EA_AL200") (6 . "Continuous") (100 . "AcDbBlockReference"))))
         (cond
           (js_bl
             (command "_.JUSTIFYTEXT" ent_txt "" (car l_just))
           )
         )
         (setq l_box (cdr l_box) l_just (cdr l_just) js_bl (ssadd))
       )
     )
   )
 )
 (setvar "CMDECHO" 1)
 (prin1)
)

[fabcad]

Bonjour,

 

Merci pour ton aide.

 

C'est vrai que j'avais cet algorithme dans la tête mais je ne voyais pas cette solution de sélection par le contour des textes.

 

Je vais décortiquer ton programme pour m'approprier ton raisonnement.

 

Bonne journée,

 

Fabcad,

[bonuscad]

Je viens de faire un essai sur l'ensemble du dessin fourni.

C'est furieusement long... :o mais ça va jusqu'au bout :P

 

Il y quand même des erreur de temps en temps du style:

ERREUR d'application: SSGET "pt" attend 1 ou 2 points

 

_QTEXT _ON serait peut être le bienvenu pour accélérer la chose.

 

De même un:

(vlax-put ename 'InsertionPoint ....)

ainsi qu'un

(vlax-put ename 'Alignment 12 6 8 ou 14)

serait peut être plus rapide que la commande _.JUSTIFYTEXT"

 

En tout cas ça demande à être travaillé encore.

[bonuscad]

Bon, ça ma turlupiner cette lenteur...

 

J'ai revu un peu le code pour m'affranchir des appels à (command) et des sélections graphiques par points.

Avec cette version plus besoin de zoom (j'ai "shunter" la fonction (cirsel) de (gile), qui dans ton cas n'apportait pas grand chose), cela à éliminé les erreurs d'appel à (ssget) par points.

 

Malheureusement le traitement reste long (pour moi environ 10mm) pour l'ensemble de la sélection. Il faut dire que pour 3732 Textes je multiplie par 4 (les 4 coins) le test par sélections, ce qui fait quand même 14928 sélections à tester.

 

Voici la version, qui reste basique (mais fiable) et juste adaptée à ton dessin (pas de controle, pas vérifié si des SCU particuliers pouvait ne pas fonctionner)

 

Si d'autres ont des idées pour améliorer...

 

(defun c:toto ( / js_text tol n ename ll ur l_box l_just js_bl)
 (princ "\nChoix des texte à justifier par rapport au bloc associé.")
 (setq
   js_text
   (ssget
     '(
       (0 . "TEXT")
       (67 . 0)
       (410 . "Model")
       (8 . "EA_AL200")
       (6 . "Continuous")
       (100 . "AcDbText")
     )
   )
   tol 0.2
 )
 (cond
   (js_text
     (repeat (setq n (sslength js_text))
       (setq ename (vlax-ename->vla-object (ssname js_text (setq n (1- n)))))
       (vla-GetBoundingBox ename 'll 'ur)
       (setq
         ll (safearray-value ll)
         ur (safearray-value ur)
         l_box (list ll (list (car ll) (cadr ur) 0.0) ur (list (car ur) (cadr ll) 0.0))
         l_just '(12 6 8 14)
       )
       (repeat 4
         (setq js_bl
           (ssget "_X"
             (list
               '(0 . "INSERT")
               '(67 . 0)
               '(410 . "Model")
               '(8 . "EA_AL200")
               '(6 . "Continuous")
               '(100 . "AcDbBlockReference")
               '(-4 . "<AND")
                 '(-4 . ">,>,*") (cons 10 (mapcar '- (car l_box) (list tol tol 0.0)))
                 '(-4 . "<,<,*") (cons 10 (mapcar '+ (car l_box) (list tol tol 0.0)))
               '(-4 . "AND>")
             )
           )
         )
         (cond
           (js_bl
             (vlax-put ename 'Alignment (car l_just))
             (vlax-put ename 'TextAlignmentPoint (car l_box))
           )
         )
         (setq
           l_box (cdr l_box)
           l_just (cdr l_just)
         )
       )
     )
   )
 )
 (prin1)
)

[fabcad]

Bonjour,

 

Merci pour l’intérêt que tu portes à ce genre de traitement.

 

En ré-indentant mon programme, j'ai déclaré toutes mes variables et ma routine a fonctionné comme par magie.

 

Je vais chronométrer comme tu fais pour voir la différence de temps.

 

En lisant ton programme, il serait souhaitable de cliquer sur une entité texte pour récupérer le calque ou par un autre moyen car il y deux calques d'altitudes pour du 200 et du 500ème nommés

EA_AL200 et EA_AL500 pour ainsi créer la sélection filtrée.

 

Bonne journée,

 

Fabcad,

 

Le Rennais Métropolitain

 

;; CIRCSEL par Gille Chanteau

;; crée un jeu de sélection à partir d'un cercle

;; Arguments

;; cen = centre du cercle (point coordonnées SCU)

;; rad = rayon du cercle (réel)

;; mod = mode de sélection ("_CP" ou "_WP")

;; fltr = filtre de sélection (liste comme pour ssget)

 

(defun circsel (cen rad mod fltr / ang lst)

(setq ang 0)

(repeat 50

(setq lst (cons (polar cen ang rad) lst)

ang (+ ang (/ pi 25))

)

)

(ssget mod lst fltr)

)

 

;; Fonction principale

;; Permet de créer la Justification des côtes Altimétriques pour faciliter le

;; changement de la taille des textes.

 

(defun c:Justification_cotes_Altis

(/

I L i

base

bloc_en_cours

calque_maitre

filtre_calque

filtre_nom_de_bloc

filtre_type

fltr

insertion_bloc

justif_trouvee

maitre_de_selection

nom_bloc_maitre

nombre_blocs

nombre_textuels

rad

selection_points_altis

selection_textuels

t_lst

textuel_en_cours

type_maitre

valeur_qtextmode

x_base x_ins_bloc

y_base y_ins_bloc

)

 

(setvar "cmdecho" 0)

(setq valeur_qtextmode (getvar "QTEXTMODE"))

(setvar "QTEXTMODE" 1)

(command "REGEN")

(setq

rad 0.05

maitre_de_selection (car (entsel "\n Pointez un bloc alti pour la sélection : "))

calque_maitre (cdr (assoc 8 (entget maitre_de_selection)))

type_maitre (cdr (assoc 0 (entget maitre_de_selection)))

);fin setq

 

(setq

fltr (list '(0 . "TEXT,MTEXT") (cons 8 calque_maitre))

)

 

; Si l'objet maitre est de type "INSERT"

(if (= type_maitre "INSERT")

(progn

;creation des filtres

(setq

filtre_calque (cons 8 calque_maitre)

filtre_type (cons 0 type_maitre)

filtre_nom_de_bloc (cons 2 (cdr (assoc 2 (entget maitre_de_selection))))

);fin de la creation des filtres

(setq selection_points_altis (ssget (list filtre_type filtre_nom_de_bloc filtre_calque)))

);fin progn

);fin if si l'objet maitre est de type "INSERT"

 

;; Traitement sur la sélection des Points

(setq nombre_blocs (sslength selection_points_altis))

(setq i 0)

(while (<= i (- nombre_blocs 1))

 

(setq bloc_en_cours (ssname selection_points_altis i))

(setq insertion_bloc (cdr (assoc 10 (entget bloc_en_cours))))

(setq

x_ins_bloc (nth 0 insertion_bloc)

y_ins_bloc (nth 1 insertion_bloc)

)

(setq selection_textuels (circsel insertion_bloc rad "_CP" fltr))

(setq nombre_textuels (sslength selection_textuels))

(if (= nombre_textuels 1)

(progn

;;; met dans t_lst la liste dxf du textuel

(setq textuel_en_cours (ssname selection_textuels 0))

(setq t_lst (entget (ssname selection_textuels 0)))

(if

(or

(= "MTEXT" (cdr (assoc 0 t_lst)))

(and

(= "TEXT" (cdr (assoc 0 t_lst)))

(= 0 (cdr (assoc 73 t_lst)))

(= 0 (cdr (assoc 72 t_lst)))

);fin and

(and

(= "ATTRIB" (cdr (assoc 0 t_lst)))

(= 0 (cdr (assoc 74 t_lst)))

(= 0 (cdr (assoc 72 t_lst)))

);fin and

);fin or

(setq base (trans (cdr (assoc 10 t_lst)) 0 1))

(setq base (trans (cdr (assoc 11 t_lst)) 0 1))

);fin if

 

(setq

x_base (nth 0 base)

y_base (nth 1 base)

)

 

;;; x_ins_bloc, y_ins_bloc

 

;(setq ang (angle base insertion_bloc))

(setq justif_trouvee

(cond

((and (> x_base x_ins_bloc) (> y_base y_ins_bloc)) "BG")

((and (> x_base x_ins_bloc) (< y_base y_ins_bloc)) "HG")

((and (< x_base x_ins_bloc) (> y_base y_ins_bloc)) "BD")

((and (< x_base x_ins_bloc) (< y_base y_ins_bloc)) "HD")

(T "MC")

);fin cond

)

(command "JUSTIFIERTEXTE" textuel_en_cours "" justif_trouvee);fin command JUSTIFIERTEXTE

(command "CHPROP" textuel_en_cours "" "COuleur" "ducalque" "");fin command CHPROP

);fin progn

(princ "\nTrops d'objets sélectionnés ! ")

);fin if

(prompt (strcat "\r Traitement de " (itoa i) " Blocs alti sur " (itoa nombre_blocs) " Blocs alti. "))

(setq i (+ i 1))

); fin while

 

(setvar "QTEXTMODE" valeur_qtextmode)

(command "REGEN")

);fin defun Justification_cotes_Altis

[/code

[bonuscad]

En lisant ton programme, il serait souhaitable de cliquer sur une entité texte pour récupérer le calque ou par un autre moyen car il y deux calques d'altitudes pour du 200 et du 500ème nommés

 

Ca fait partie du fignolage, je te l'ai fait dans cette version qui devrait être plus générique. (accepte des références d'Insertion, Point ou centre de Cercle)

 

J'ai essayé d’accélérer le code, pour ceci j'ai modifié la boucle (repeat en (while de façon à arrêter la boucle dès que la condition est bonne (inutile de parcourir les autres coins de la boite de texte si la solution est déjà trouvée)

Pour l'ensemble des textes cela a divisé le temps d’exécution par 2.

 

(vl-load-com)
(defun c:justify-text_by_ref ( / js_mod dxf_cod_ref pt_ref l_dxf dxf_cod mod_sel js_text tol n ename ll ur l_box l_just mark count js_bl)
 (princ "\nSélectionnez le modèle de référence Insertion, Point ou Cercle.")
 (while
   (null
     (setq js_mod
       (ssget "_+.:E:S"
         (list
           '(0 . "INSERT,POINT,CIRCLE")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet modèle valable pour cette fonction!")
 )
 (setq
   dxf_cod_ref (entget (ssname js_mod 0))
   pt_ref (trans (cdr (assoc 10 dxf_cod_ref)) 0 1)
   l_dxf
   (cond
     ((eq (cdr (assoc 0 dxf_cod_ref)) "INSERT") '(0 100 67 410 2 8 6 62 41 42 43 210))
     ((eq (cdr (assoc 0 dxf_cod_ref)) "POINT") '(0 100 67 410 2 8 6 62 39 210))
     ((eq (cdr (assoc 0 dxf_cod_ref)) "CIRCLE") '(0 100 67 410 2 8 6 62 39 40 210))
   )
 )
 (setq dxf_cod_ref (vl-remove nil (mapcar '(lambda (x) (assoc x dxf_cod_ref)) l_dxf)))
 (princ "\nChoix du modèle des textes à justifier par rapport au Bloc/Point/Cercle associé.")
 (while
   (null
     (setq js_mod
       (ssget "_+.:E:S"
         (list
           '(0 . "*TEXT")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nCe n'est pas un modèle d'objet texte valable pour cette fonction!")
 )
 (setq dxf_cod (entget (ssname js_mod 0)))
 (setq dxf_cod (vl-remove nil (mapcar '(lambda (x) (assoc x dxf_cod)) '(0 100 67 410 8 6 62 40 7 210))))
 (initget "Unique Tout Manuel _Single All Manual")
 (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]<Manuel>: ")) "Single")
   (setq js_text js_mod)
   (if (eq mod_sel "All")
       (setq js_text (ssget "_X" dxf_cod))
       (setq js_text (ssget dxf_cod))
   )
 )
 (cond
   (js_text
     (initget 7)
     (setq tol (getdist pt_ref "n\Distance de tolérance à la référence: "))
     (repeat (setq n (sslength js_text))
       (setq ename (vlax-ename->vla-object (ssname js_text (setq n (1- n)))))
       (vla-GetBoundingBox ename 'll 'ur)
       (setq
         ll (safearray-value ll)
         ur (safearray-value ur)
         l_box (list ll (list (car ll) (cadr ur) 0.0) ur (list (car ur) (cadr ll) 0.0))
         l_just '(12 6 8 14)
         mark t
         count 0
       )
       (while (and mark (< count 4))
         (setq js_bl
           (ssget "_X"
             (append
               dxf_cod_ref
               (list
                 (cons -4 "<AND")
                   (cons -4 ">,>,*") (cons 10 (mapcar '- (car l_box) (list tol tol 0.0)))
                   (cons -4 "<,<,*") (cons 10 (mapcar '+ (car l_box) (list tol tol 0.0)))
                 (cons -4 "AND>")
               )
             )
           )
         )
         (cond
           (js_bl
             (vlax-put ename 'Alignment (car l_just))
             (vlax-put ename 'TextAlignmentPoint (car l_box))
             (setq mark nil)
           )
           (T (setq mark T))
         )
         (setq
           l_box (cdr l_box)
           l_just (cdr l_just)
           count (1+ count)
         )
       )
     )
   )
 )
 (prin1)
)

[Patrick_35]

Salut Bonus

 

Sans rentrer réellement dans le code, je pense que tu peux utiliser vla-get-activeselectionset pour accélérer la routine, d'autant que tu transformes tes objets en sélection vla

 

Un exemple simple qui liste les blocs d'un dessin.

(defun c:test(/ ele sel)
 (ssget "x" (list (cons 0 "insert")))
 (vlax-for ele (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
   (princ (strcat "\n" (vla-get-name ele)))
 )
 (vla-delete sel)
 (princ)
)

 

@+