\"DIMSTYLE\" en (Auto/Visual)LISP

[BIM G CO]

Toujours pour nettoyer des plan d'architecte plus ou moins fastidieux.

 

Je cherche à nettoyer les styles de cote récalcitrant j'ai ce programme :

 

;;; -------------------------------------------------------------------------------------------------
(defun table_entete (TB / TBLIST TBLIST TBNAME RES)
 (setq TBNLIST nil)
 (setq TBLIST (tblnext TB T))
 (while TBLIST
   (setq TBNAME (cdr (assoc 2 TBLIST)))
   (setq TBNLIST (append TBNLIST (list TBNAME)))
   (setq TBLIST (tblnext TB))
 )
 (setq RES TBNLIST)
)
;;; ----------------------------------------------------------------------
(defun RAZDIMSTYLE (/ DS SS n)
 (setq DS (table_entete "DIMSTYLE"))
 (foreach n DS
   (setq SS (entget (tblobjname "DIMSTYLE" n))
  SS (subst (cons 5 "_small") (assoc 5 SS) SS) ; pointe de flèche
  SS (subst (cons 6 "_small") (assoc 6 SS) SS) ; pointe de flèche
  SS (subst (cons 7 "_small") (assoc 7 SS) SS) ; pointe de flèche
  SS (subst '(176 . 256) (assoc 176 SS) SS) ; Variable DIMCLRD
  SS (subst '(177 . 256) (assoc 177 SS) SS) ; Variable DIMCLRE
  SS (subst '(178 . 256) (assoc 178 SS) SS) ; Variable DIMCLRT
   )
   ;; (princ SS)
   (entmod SS)
 )
)
;;; -------------------------------------------------------------------------------------------------

 

Le problème n'est pas sur la couleur ou le fonctionnement du lisp mais surtout comment changer les pointes de flèche de tous les styles de cotes (environ 300 styles avec chacune 10 à cotes).

 

Merci d'avance de votre sollicitude pour une réponse.

 

[sechanbask]

tu ne veux pas utiliser mon programme en vba, il ne te plait pas ?

 

Bon tant pis pour toi, je te laisse quand même la méthode que tu pourras appliquer en lisp. Cette méthode ne modifie pas le style de cote mais les cotes donc c'est pas très propre mais ça permet de faire le ménage quand même :

For Each ent In ThisDrawing.ModelSpace
'si ent est une cote (permet de traiter toute les coté sans savoir si elle est alignée, linéaire etc.)
           If VBA.Right(ent.ObjectName, 9) = "Dimension" Then
'récupérer le nom de la coté dans strCote
           strCote = ent.ObjectName
           End If

'une cote...
Case strCote

Set objCote = ent
'formater la couleur de la ligne en DUCALQUE
objCote.DimensionLineColor = acByLayer
'formater la couleur de la ligne d'attache en DUCALQUE
objCote.ExtensionLineColor = acByLayer
'formater la couleur du texte en DUCALQUE
objCote.TextColor = acByLayer
Next

[BIM G CO]

C'est surtout que j'ai pommé ton programme en VBA! mais merci de me l'avoir retransmis par msn dernièrement.

[sechanbask]

bravo ! je pensais que mon programme était inoubliable, à jamais gravé dans la pierre ...

 

Je suis déçu... snif