Justifier (boite de dialogue)

(gile) · le 14 novembre 2007

Je ne suis pas sûr que ce soit d'une grande utilité (il y a déjà tellement de façons pour changer la justification des textes), mais comme le gros deu boulot était fait (voir ce sujet), je n'ai fait que peaufiner ma routine (boite de dialogue sans DCL séparé, et possibilité d'entre les options sur la ligne de commande).

Rien d'extraordinaire, ça fonctionne avec les textes simples ou multilignes et les définitions d'attributs quelque soit le SCU courant et le SCO de l'objet. Une option permet de conserver la position du point d'insertion.

http://img210.imageshack.us/img210/357/juid4.png

La commande s'appele JU pour la boite dialogue -JU pour la ligne de commande.

;; JU (gile) 14/11/07
;; Pour justifier des textes simples ou multilignes et des définitions d'attributs
;; à partir d'une boite de dialogue ou de la ligne de commande (commande : -ju)
;; Une option permet de conserver le point d'insertion fixe.

;; Boite d dialogue

(defun c:ju (/ trp mxv mxm column ss temp file dcl_id just ins)

 ;; Doug Wilson
 (defun trp (m) (apply 'mapcar (cons 'list m)))

 ;; Vladimir Nesterovsky
 (defun mxv (m v)
   (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
 )

 ;; Vladimir Nesterovsky
 (defun mxm (m q)
   (mapcar (function (lambda (r) (mxv (trp q) r))) m)
 )

 (defun column	(l1 l2)
   (apply 'strcat
   (mapcar
     (function
       (lambda (x1 x2)
	 (strcat
	   ":button{width=12;label="
	   (vl-prin1-to-string x1)
	   ";key="
	   (vl-prin1-to-string x2)
	   ";allow_accept=true;}"
	 )
       )
     )
     l1
     l2
   )
   )
 )

 (if (setq ss (ssget '((0 . "*TEXT,ATTDEF"))))
   (progn
     (or (getenv "PointInsertionFixe")
  (setenv "PointInsertionFixe" "0")
     )
     (setq temp (vl-filename-mktemp "Tmp.dcl")
    file (open temp "w")
     )
     (write-line
"justify:dialog{label=\"Justifier\";:boxed_row{"
file
     )
     (mapcar
(function
  (lambda (x)
    (write-line
      (strcat ":column{" (column (car x) (cadr x)) "}")
      file
    )
  )
)
'((("Haut Gauche" "Milieu Gauche" "Gauche" "Bas Gauche")
   ("HG" "MG" "G" "BG")
  )
  (("Haut Centre" "Milieu Centre" "Centre" "Bas Centre")
   ("HC" "MC" "C" "BC")
  )
  (("Haut Droite" "Milieu Droite" "Droite" "Bas Droite")
   ("HD" "MD" "D" "BD")
  )
 )
     )
     (write-line
"}spacer;:toggle{label=\"Point d'insertion fixe\";key=\"ins\";}
spacer;cancel_button;}"
file
     )
     (close file)
     (setq dcl_id (load_dialog temp))
     (if (not (new_dialog "justify" dcl_id))
(exit)
     )
     (set_tile "ins" (getenv "PointInsertionFixe"))
     (foreach k '("G" "C" "D" "HG" "HC" "HD" "MG" "MC" "MD" "BG" "BC" "BD")
(action_tile
  k
  (strcat
    "(setq just "
    (vl-prin1-to-string k)
    ")(if (= \"1\" (get_tile \"ins\"))
	  (setq ins T) (setq ins nil)) (done_dialog)"
  )
)
     )
     (action_tile "cancel" "(setq just nil)")
     (start_dialog)
     (unload_dialog dcl_id)
     (vl-file-delete temp)
     (if ins
(setenv "PointInsertionFixe" "1")
(setenv "PointInsertionFixe" "0")
     )
     (and just (justify ss just ins))
   )
 )
 (princ)
)

;; Ligne de commande
(defun c:-ju (/ ss par just ins)
 (if (setq ss (ssget '((0 . "*TEXT,ATTDEF"))))
   (progn
     (or (getenv "PointInsertionFixe")
  (setenv "PointInsertionFixe" "0")
     )
     (while (or (not just) (= just "Paramètre"))
(princ (strcat "\nParamètre courant : "
	       (if (= (getenv "PointInsertionFixe") "0")
		 "texte fixe.\t"
		 "point d'insertion fixe.\t"
	       )
       )
)
(initget
  "Gauche Centre Droite HG HC HD MG MC MD BG BC BD Paramètre"
)
(setq just
       (getkword
	 "Entrez une option de justification\n
[Gauche/Centre/Droite/HG/HC/HD/MG/MC/MD/BG/BC/BD/Paramètre] <Paramètre>: "
       )
)
(if (or (not just) (= just "Paramètre"))
  (progn
    (initget 1 "Oui Non")
    (setq par (getkword "\nPoint d'insertion fixe ? [Oui/Non]: "))
    (if	(= par "Oui")
      (setenv "PointInsertionFixe" "1")
      (setenv "PointInsertionFixe" "0")
    )
  )
)
     )
     (and (= (getenv "PointInsertionFixe") "1") (setq ins T))
     (and just (justify ss just ins))
   )
 )
 (princ)
)

;; Modifie la justification des textes sélectionnés

(defun justify (ss just ins / n elst org pos oj nj x y ang mat dep vert)
 (repeat (setq n (sslength ss))
   (setq elst (entget (ssname ss (setq n (1- n))))
  org  (cdr (assoc 10 elst))
   )
   (if	(= (cdr (assoc 0 elst)) "MTEXT")
     ;; texte multiligne
     (progn
(cond
  ((setq pos (vl-position just '("G" "C" "D")))
   (setq pos (+ 7 pos))
  )
  (T
   (setq pos (vl-position
	       just
	       '(nil "HG" "HC" "HD" "MG" "MC" "MD" "BG" "BC" "BD")
	     )
   )
  )
)
(setq oj   (cdr (assoc 71 elst))
      elst (subst (cons 71 pos) (assoc 71 elst) elst)
)
(entmod elst)
;; repositionnement du texte
(and
  (not ins)
  (setq	elst (entget (cdr (assoc -1 elst)))
	nj   (cdr (assoc 71 elst))
	y    (cond
	       ((and (< 6 oj) (< nj 4)) (cdr (assoc 43 elst)))
	       ((or (and (< 3 oj 7) (< nj 4)) (and (< 6 oj) (< 3 nj 7)))
		(/ (cdr (assoc 43 elst)) 2.)
	       )
	       ((or (and (< oj 4) (< 3 nj 7)) (and (< 3 oj 7) (< 6 nj)))
		(/ (cdr (assoc 43 elst)) -2.)
	       )
	       ((and (< oj 4) (< 6 nj)) (- (cdr (assoc 43 elst))))
	       (T 0.0)
	     )
	oj   (rem oj 3)
	nj   (rem nj 3)
	x    (cond
	       ((= oj nj) 0.0)
	       ((and (= oj 1) (= nj 0)) (cdr (assoc 42 elst)))
	       ((and (= oj 0) (= nj 1)) (- (cdr (assoc 42 elst))))
	       ((or (and (= oj 1) (= nj 2)) (and (= oj 2) (= nj 0)))
		(/ (cdr (assoc 42 elst)) 2.)
	       )
	       (T (/ (cdr (assoc 42 elst)) -2.))
	     )
	ang  (angle '(0 0 0)
		    (trans (cdr (assoc 11 elst)) 0 (cdr (assoc 210 elst)))
	     )
	mat  (mxm (mapcar (function (lambda (v)
				      (trans v 0 (cdr (assoc 210 elst)))
				    )
			  )
			  '((1 0 0) (0 1 0) (0 0 1))
		  )
		  (list	(list (cos ang) (- (sin ang)) 0)
			(list (sin ang) (cos ang) 0)
			'(0 0 1)
		  )
	     )
	dep  (mxv mat (list x y 0.0))
  )
  (entmod
    (subst (cons 10
		 (mapcar '+ (cdr (assoc 10 elst)) dep)
	   )
	   (assoc 10 elst)
	   elst
    )
  )
)
     )

     ;; texte simple ou définition d'attribut
     (progn
(if (= (cdr (assoc 0 elst)) "TEXT")
  (setq vert 73)
  (setq vert 74)
)
(if (= (cdr (assoc 72 elst)) (cdr (assoc vert elst)) 0)
  (setq
    elst (subst (cons 11 org) (assoc 11 elst) elst)
  )
  (setq
    elst (subst (cons 10 (cdr (assoc 11 elst))) (assoc 10 elst) elst)
  )
)
(setq elst
       (subst (cons vert
		    (cond
		      ((wcmatch just "B*") 1)
		      ((wcmatch just "M*") 2)
		      ((wcmatch just "H*") 3)
		      (T 0)
		    )
	      )
	      (assoc vert elst)
	      (subst (cons 72
			   (cond
			     ((wcmatch just "*G") 0)
			     ((wcmatch just "*C") 1)
			     ((wcmatch just "*D") 2)
			   )
		     )
		     (assoc 72 elst)
		     elst
	      )
       )
)
(entmod elst)
;; repositionnement du texte
(and
  (not ins)
  (setq elst (entget (cdr (assoc -1 elst))))
  (if (= (cdr (assoc 72 elst)) (cdr (assoc vert elst)) 0)
    (entmod (subst (cons 10 org) (assoc 10 elst) elst))
    (progn
      (setq dep (mapcar '- org (cdr (assoc 10 elst))))
      (entmod
	(subst (cons 11 (mapcar '+ (cdr (assoc 11 elst)) dep))
	       (assoc 11 elst)
	       elst
	)
      )
    )
  )
)
     )
   )
 )
)

[Edité le 14/11/2007 par (gile)]

Matt666 · le 15 novembre 2007

(mapcar
               ( [surligneur] function [/surligneur] 
                   (lambda (x)
                       (write-line
                           (strcat ":column{" (column (car x) (cadr x)) "}")
                           file
                       )
                   )
               )
               '((("Haut Gauche" "Milieu Gauche" "Gauche" "Bas Gauche")
                       ("HG" "MG" "G" "BG")
                   )
                   (("Haut Centre" "Milieu Centre" "Centre" "Bas Centre")
                       ("HC" "MC" "C" "BC")
                   )
                   (("Haut Droite" "Milieu Droite" "Droite" "Bas Droite")
                       ("HD" "MD" "D" "BD")
                   )
               )
           )

pas mal ce petit bout de code ! bravo !!

Intéressant à regarder, en tout cas ! Voir comment uiliser vl-filename-mktemp...

A bientot !

Matt.

[Edité le 15/11/2007 par Matt666]

Matt666 · le 15 novembre 2007

Pour ceux qui veulent comprendre cette routine, j'ai retranscris la routine de Gile pour séparer le lisp du dcl. La comparaison n'en sera que plus facile.

Le dcl :

justify : dialog {
label= "Justifier"; 
: boxed_row {
	:column {
		:button { width=12; label= "Haut Gauche"; key="HG"; allow_accept=true;}
		:button { width=12; label= "Milieu Gauche"; key="MG"; allow_accept=true;}
		:button { width=12; label= "Gauche"; key="G"; allow_accept=true;}
		:button { width=12; label= "Bas Gauche"; key="BG"; allow_accept=true;}
		spacer ;
	}
	:column {
		:button { width=12; label= "Haut Centre"; key="HC"; allow_accept=true;}
		:button { width=12; label= "Milieu Centre"; key="MC"; allow_accept=true;}
		:button { width=12; label= "Centre"; key="C"; allow_accept=true;}
		:button { width=12; label= "Bas Centre"; key="BC"; allow_accept=true;}
		spacer ;
	}
	:column {
		:button { width=12; label= "Haut Droite"; key="HD"; allow_accept=true;}
		:button { width=12; label= "Milieu Droite"; key="MD"; allow_accept=true;}
		:button { width=12; label= "Droite"; key="D"; allow_accept=true;}
		:button { width=12; label= "Bas Droite"; key="BD"; allow_accept=true;}
		spacer ;
	}
}
spacer;
: row {
	:toggle {label="Point d'insertion fixe"; key="ins";}
       	spacer;
	cancel_button;
}
}

Le lisp :

;; JU (gile) 14/11/07
;; Pour justifier des textes simples ou multilignes et des définitions d'attributs
;; à partir d'une boite de dialogue ou de la ligne de commande (commande : -ju)
;; Une option permet de conserver le point d'insertion fixe.

;; Boite de dialogue à nommer "Justifier.dcl"

(defun c:ju (/ column ss dcl_id just ins)

   (if (setq ss (ssget '((0 . "*TEXT,ATTDEF"))))
       (progn
           (or (getenv "PointInsertionFixe")
               (setenv "PointInsertionFixe" "0")
           )
           (setq dcl_id (load_dialog "Justifier.dcl"))
           (if (not (new_dialog "justify" dcl_id))
               (exit)
           )
           (set_tile "ins" (getenv "PointInsertionFixe"))
           (foreach k '("G" "C" "D" "HG" "HC" "HD" "MG" "MC" "MD" "BG" "BC" "BD")
               (action_tile
                   k
                   (strcat
                       "(setq just "
                       (vl-prin1-to-string k)
                       ")(if (= \"1\" (get_tile \"ins\"))
                       (setq ins T) (setq ins nil)) (done_dialog)"
                   )
               )
           )
           (action_tile "cancel" "(setq just nil)")
           (start_dialog)
           (unload_dialog dcl_id)
           (if ins
               (setenv "PointInsertionFixe" "1")
               (setenv "PointInsertionFixe" "0")
           )
           (and just (justify ss just ins))
       )
   )
   (princ)
)

;; Ligne de commande
(defun c:-ju (/ ss par just ins)
   (if (setq ss (ssget '((0 . "*TEXT,ATTDEF"))))
       (progn
           (or (getenv "PointInsertionFixe")
               (setenv "PointInsertionFixe" "0")
           )
           (while (or (not just) (= just "Paramètre"))
               (princ (strcat "\nParamètre courant : "
                       (if (= (getenv "PointInsertionFixe") "0")
                           "texte fixe.\t"
                           "point d'insertion fixe.\t"
                       )
                   )
               )
               (initget
                   "Gauche Centre Droite HG HC HD MG MC MD BG BC BD Paramètre"
               )
               (setq just
                   (getkword
                       "Entrez une option de justification\n
                       [Gauche/Centre/Droite/HG/HC/HD/MG/MC/MD/BG/BC/BD/Paramètre] : "
                   )
               )
               (if (or (not just) (= just "Paramètre"))
                   (progn
                       (initget 1 "Oui Non")
                       (setq par (getkword "\nPoint d'insertion fixe ? [Oui/Non]: "))
                       (if (= par "Oui")
                           (setenv "PointInsertionFixe" "1")
                           (setenv "PointInsertionFixe" "0")
                       )
                   )
               )
           )
           (and (= (getenv "PointInsertionFixe") "1") (setq ins T))
           (and just (justify ss just ins))
       )
   )
   (princ)
)

;; Modifie la justification des textes sélectionnés

(defun justify (ss just ins / n elst org pos oj nj x y ang mat dep vert)
   (repeat (setq n (sslength ss))
       (setq elst (entget (ssname ss (setq n (1- n))))
           org (cdr (assoc 10 elst))
       )
       (if (= (cdr (assoc 0 elst)) "MTEXT")
           ;; texte multiligne
           (progn
               (cond
                   ((setq pos (vl-position just '("G" "C" "D")))
                       (setq pos (+ 7 pos))
                   )
                   (T
                       (setq pos (vl-position
                               just
                               '(nil "HG" "HC" "HD" "MG" "MC" "MD" "BG" "BC" "BD")
                           )
                       )
                   )
               )
               (setq oj (cdr (assoc 71 elst))
                   elst (subst (cons 71 pos) (assoc 71 elst) elst)
               )
               (entmod elst)
               ;; repositionnement du texte
               (and
                   (not ins)
                   (setq 
                       elst (entget (cdr (assoc -1 elst)))
                       nj (cdr (assoc 71 elst))
                       y (cond
                           ((and (< 6 oj) (< nj 4)) (cdr (assoc 43 elst)))
                           ((or (and (< 3 oj 7) (< nj 4)) (and (< 6 oj) (< 3 nj 7)))
                               (/ (cdr (assoc 43 elst)) 2.)
                           )
                           ((or (and (< oj 4) (< 3 nj 7)) (and (< 3 oj 7) (< 6 nj)))
                               (/ (cdr (assoc 43 elst)) -2.)
                           )
                           ((and (< oj 4) (< 6 nj)) (- (cdr (assoc 43 elst))))
                           (T 0.0)
                       )
                       oj (rem oj 3)
                       nj (rem nj 3)
                       x (cond
                           ((= oj nj) 0.0)
                           ((and (= oj 1) (= nj 0)) (cdr (assoc 42 elst)))
                           ((and (= oj 0) (= nj 1)) (- (cdr (assoc 42 elst))))
                           ((or (and (= oj 1) (= nj 2)) (and (= oj 2) (= nj 0)))
                               (/ (cdr (assoc 42 elst)) 2.)
                           )
                           (T (/ (cdr (assoc 42 elst)) -2.))
                       )
                       ang (angle '(0 0 0)
                           (trans (cdr (assoc 11 elst)) 0 (cdr (assoc 210 elst)))
                       )
                       mat (mxm (mapcar (function (lambda (v)
                                       (trans v 0 (cdr (assoc 210 elst)))
                                   )
                               )
                               '((1 0 0) (0 1 0) (0 0 1))
                           )
                           (list (list (cos ang) (- (sin ang)) 0)
                               (list (sin ang) (cos ang) 0)
                               '(0 0 1)
                           )
                       )
                       dep (mxv mat (list x y 0.0))
                   )
                   (entmod
                       (subst (cons 10
                               (mapcar '+ (cdr (assoc 10 elst)) dep)
                           )
                           (assoc 10 elst)
                           elst
                       )
                   )
               )
           )
           
           ;; texte simple ou définition d'attribut
           (progn
               (if (= (cdr (assoc 0 elst)) "TEXT")
                   (setq vert 73)
                   (setq vert 74)
               )
               (if (= (cdr (assoc 72 elst)) (cdr (assoc vert elst)) 0)
                   (setq
                       elst (subst (cons 11 org) (assoc 11 elst) elst)
                   )
                   (setq
                       elst (subst (cons 10 (cdr (assoc 11 elst))) (assoc 10 elst) elst)
                   )
               )
               (setq elst
                   (subst (cons vert
                           (cond
                               ((wcmatch just "B*") 1)
                               ((wcmatch just "M*") 2)
                               ((wcmatch just "H*") 3)
                               (T 0)
                           )
                       )
                       (assoc vert elst)
                       (subst (cons 72
                               (cond
                                   ((wcmatch just "*G") 0)
                                   ((wcmatch just "*C") 1)
                                   ((wcmatch just "*D") 2)
                               )
                           )
                           (assoc 72 elst)
                           elst
                       )
                   )
               )
               (entmod elst)
               ;; repositionnement du texte
               (and
                   (not ins)
                   (setq elst (entget (cdr (assoc -1 elst))))
                   (if (= (cdr (assoc 72 elst)) (cdr (assoc vert elst)) 0)
                       (entmod (subst (cons 10 org) (assoc 10 elst) elst))
                       (progn
                           (setq dep (mapcar '- org (cdr (assoc 10 elst))))
                           (entmod
                               (subst (cons 11 (mapcar '+ (cdr (assoc 11 elst)) dep))
                                   (assoc 11 elst)
                                   elst
                               )
                           )
                       )
                   )
               )
           )
       )
   )
)

A bientot.

Matt.

[Edité le 15/11/2007 par Matt666]

Connexion

Justifier (boite de dialogue)

Messages recommandés

(gile)

Lien vers le commentaire

Partager sur d’autres sites

Matt666

Lien vers le commentaire

Partager sur d’autres sites

Matt666

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante