Aller au contenu

lisp creation de calques en fonctionde la couleur forcées des objetss


Messages recommandés

Posté(e)

Bonjour,

 

Il suffit d'ajouter une 2ème altération :

- cocher couleur

- cliquer sur valeur

- choisir Ducalque et valider

- cliquer sur ajouter pour ajouter une seconde ligne dans la liste des altérations (en plus de celle concernant le calque)

ji7s.gif

 

Olivier

Posté(e)

Hello Les Jeunes Padawans

 

Dans un genre un peu different, je vous redonne une Superbe Routine Lisp de notre regrette Patrick_35 !

Patrick l'avait developpe suite a ma demande ...

 

Cette Routine TRI "eclate / separe" TOUTES les entites du DWG sur N calques par le Type d'Entite !

 

C Tip-Top pour avoir UN SEUL Type d'Entite PAR CALQUE !!

 

Pas besoin d'une Requete sur le Groupe de Dessins avec MAP (ou CIVIL) !

La Routine TRI fonctionne sur AutoCAD, ACAD Archi, etc ...

 

Au fait SVP ce QUOI serait la Micro-Modif Ultra-Simple pour pouvoir selectionner QUE une partie du DWG afin que la routine ne traite pas TOUT le DWG !? ... (if (ssget "x") ...

 

Merci d'avance, LA SANTE, Bonne Annee, Bye, lecrabe "triste"

Que la Force soit avec Vous et Vos Proches !

 


;;
;; Tri des entites par calque et transfert dans des sous-calques
;;
;; Si Calque nomme A alors --> A__TEXT, A__2LINE, A__HATCH, A__POLYLINE, etc
;; 
;; Par Patrick_35 le 23/03/2009 pour Patrice B.
;;
;; Nouvelle version 1.1 qui separe XREF & BLOC et fonctionne sur AutoCAD >= 2000
;;

(defun c:TRI (/ doc ent lay lck nom ori pro sel tot txt)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc) 

 (if (ssget "x") 

   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(cond
  ((and (eq (vla-get-objectname ent) "AcDbBlockReference")
	(vlax-property-available-p ent 'path)
    )
    (setq nom "Xref")
  )
  (T
    (setq txt (substr (vla-get-objectname ent) 5)
	  tot 2
    )
    (while (and (> (vl-string-elt txt tot) 90)
		(< tot (1- (strlen txt)))
	   )
      (setq tot (1+ tot))
    )
    (and (eq (1- (strlen txt)) tot)
      (setq tot (1+ tot))
    )
    (setq nom (substr txt 1 tot))
  )
)
(setq ori (vla-item (vla-get-layers doc) (vla-get-layer ent))
      lck (vla-get-lock ori)
)

;;	(or (wcmatch (vla-get-layer ent) (strcat "* - " nom))
;;	    (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list ;; (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) " - " nom))))))

(or (wcmatch (vla-get-layer ent) (strcat "*__" nom))
    (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) "__" nom))))))

	 (setq lay (vla-add (vla-get-layers doc) txt))
	 (foreach pro '('color 'freeze 'layeron 'linetype 'lineweight 'material 'plottable 'viewportdefault)
	   (and (vlax-property-available-p lay (eval pro))
	     (vlax-put lay (eval pro) (vlax-get ori (eval pro)))
	   )
	 )
    )
    (vla-put-lock lay :vlax-false)
    (vla-put-lock ori :vlax-false)
    (vla-put-layer ent txt)
    (vla-put-lock lay lck)
    (vla-put-lock ori lck)
)
     )
     (princ (strcat "\nTravail sur " (itoa (vla-get-count sel)) " objet(s). "))
     (vla-delete sel)
   )
   (princ "\nDessin vide! ")
 )
 (vla-endundomark doc)
 (princ) 
) 

Autodesk Expert Elite Team

Posté(e)

Au fait SVP ce QUOI serait la Micro-Modif Ultra-Simple pour pouvoir selectionner QUE une partie du DWG afin que la routine ne traite pas TOUT le DWG !? ... (if (ssget "x") ...

 

Au plus simple je dirais.. :rolleyes:

(if (ssget)  ... 

 

A+

Apprendre => Prendre => Rendre

Posté(e)

Hello Bruno

 

NON ca ne marche pas !

 

Ne faudrait il pas faire un truc du genre (setq js (ssget ...

et donc boucler sur la liste JS du jeu de selection !

 

Waiting ...

 

MERCI, Bye, lecrabe "triste"

Autodesk Expert Elite Team

Posté(e)

Hello Bruno

 

NON ca ne marche pas !

 

Ne faudrait il pas faire un truc du genre (setq js (ssget ...

et donc boucler sur la liste JS du jeu de selection !

 

Waiting ...

 

MERCI, Bye, lecrabe "triste"

 

:blink: Chez moi ça fonctionne très bien sur 2007

 

Le bouclage sur la sélection courante (sélection active) est fait ici dans le code de Patrick_35

(vlax-for ent (setq sel (vla-get-activeselectionset doc))

 

A+

Apprendre => Prendre => Rendre

Posté(e)

SVP peux tu nous redonner toute TA routine TRI avec la sélection "normale" ?

 

Pas de soucis Patrice

 

;;
;; Tri des entites par calque et transfert dans des sous-calques
;;
;; Si Calque nomme A alors --> A__TEXT, A__2LINE, A__HATCH, A__POLYLINE, etc
;; 
;; Par Patrick_35 le 23/03/2009 pour Patrice B.
;;
;; Nouvelle version 1.1 qui separe XREF & BLOC et fonctionne sur AutoCAD >= 2000
;;

(defun c:TRI (/ doc ent lay lck nom ori pro sel tot txt)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc) 

 (if (ssget) ;; sélection partiel
   ;; (ssget "X") sélection total 

   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
       (cond
         ((and (eq (vla-get-objectname ent) "AcDbBlockReference")
               (vlax-property-available-p ent 'path)
           )
           (setq nom "Xref")
         )
         (T
           (setq txt (substr (vla-get-objectname ent) 5)
                 tot 2
           )
           (while (and (> (vl-string-elt txt tot) 90)
                       (< tot (1- (strlen txt)))
                  )
             (setq tot (1+ tot))
           )
           (and (eq (1- (strlen txt)) tot)
             (setq tot (1+ tot))
           )
           (setq nom (substr txt 1 tot))
         )
       )
       (setq ori (vla-item (vla-get-layers doc) (vla-get-layer ent))
             lck (vla-get-lock ori)
       )

;;      (or (wcmatch (vla-get-layer ent) (strcat "* - " nom))
;;          (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list ;; (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) " - " nom))))))

       (or (wcmatch (vla-get-layer ent) (strcat "*__" nom))
           (and (vl-catch-all-error-p (setq lay (vl-catch-all-apply 'vla-item (list (vla-get-layers doc) (setq txt (strcat (vla-get-layer ent) "__" nom))))))

                (setq lay (vla-add (vla-get-layers doc) txt))
                (foreach pro '('color 'freeze 'layeron 'linetype 'lineweight 'material 'plottable 'viewportdefault)
                  (and (vlax-property-available-p lay (eval pro))
                    (vlax-put lay (eval pro) (vlax-get ori (eval pro)))
                  )
                )
           )
           (vla-put-lock lay :vlax-false)
           (vla-put-lock ori :vlax-false)
           (vla-put-layer ent txt)
           (vla-put-lock lay lck)
           (vla-put-lock ori lck)
       )
     )
     (princ (strcat "\nTravail sur " (itoa (vla-get-count sel)) " objet(s). "))
     (vla-delete sel)
   )
   (princ "\nDessin vide! ")
 )
 (vla-endundomark doc)
 (princ) 
) 

 

A+

Apprendre => Prendre => Rendre

  • 1 mois après...
Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité