DECKER & CAD SOLUTIONS

 

Programmes Lisp -
Source du programme Ch_style

 

(defun c:ch_style(/ resol selection style ptr entite propriete nbrmod)

 (write-line "\nTéléchargé depuis le site Internet http://www.decker-cs.com")

 (write-line "Auteur : Christian Decker")

 ;

 (write-line "Changer le style de texte.")

 ;

 (setq resol(getvar "snapmode"))         ;Sauvegarde l'état de la résol.

 (setvar "snapmode" 0)                   ;Désactive la résol.

 (setq selection(ssget))                 ;Attend la sélection d'objets.

 (setvar "snapmode" resol)               ;Restitue l'état initial de la résol.

 (setq style "")

 (while (= style "")                     ;Attend un nouveau style (chaîne non vide).

  (setq style(getstring "Nouveau style : "))

  (if (= style "")                          ;La chaîne est vide.

   (write-line "Veuillez s'il vous plaît, saisir le nouveau style.")

  )

 )

 (if (= (tblsearch "STYLE" style) nil)

  (progn                                 ;Le style de texte n'existe pas.

   (write-line (strcat "Le style de texte " style " est introuvable."))

   (princ)

  )                                      ;Le style de texte existe.

  (progn

   (setq ptr 0)

   (setq nbrmod 0)

   (repeat (sslength selection)            ;Pour chaque élément de la sélection...

    (setq entite(ssname selection ptr))       ;Obtient le nom de l'entite de la base de données.

    (setq propriete(entget entite))           ;Obtient la liste des propriétés de l'entité.

    (if (= (cdr(assoc '0 propriete)) "TEXT")     ;L'entité est un texte.

     (progn

      (setq propriete(subst (cons '7 style) (assoc '7 propriete) propriete))    ;Affecte le nouveau style à la liste des propriétés.

      (entmod propriete)                            ;Mise à jour de la liste des propriétés.

      (entupd entite)                               ;Regénération de l'entité.

      (setq nbrmod(+ nbrmod 1))

     )

    )

    (setq ptr(+ ptr 1))

   )

   (write-line (strcat "Nombre de textes modifiés : " (itoa nbrmod)))

   (princ)

  )

 )

)

 

Fermer la fenêtre 


© Copyright 2004 [DECKER CAD SOLUTIONS] Tous droits réservés.