Aller au contenu
Problème de lien d'inscription (résolu ?) ×

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

philsogood

Par philsogood
dans AutoCAD 2019

 Partager

Messages recommandés

lecrabe Mentor

lecrabe

Posté(e)
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

Lien vers le commentaire
Partager sur d’autres sites
VDH-Bruno Enthusiast

VDH-Bruno

Posté(e)
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

Lien vers le commentaire
Partager sur d’autres sites
VDH-Bruno Enthusiast

VDH-Bruno

Posté(e)
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

Lien vers le commentaire
Partager sur d’autres sites
lili2006 Rising Star

lili2006

Posté(e)
Posté(e)

Bonsoir à toutes et tous,

Olivier,

Oui, je manipule que très rarement MAP et je compte m'y remettre, ça commence plutôt bien !!smile.gif

Merci encore de ton partage de connaissances qui profite à mes étudiants au quotidien, le tout mis mis bout à bout,..

Civil 3D 2025 - COVADIS_18.3b

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites
lili2006 Rising Star

lili2006

Posté(e)
Posté(e)

Re,

Je viens de tester la manip, et j'ai tous les calques qui arrivent de couleurs noir, certes mais aussi toutes les entités du dessin !!huh.gif

C'est exactement l'inverse que je souhaiterez (mais peut être pas possible,..), à savoir les calques de la même couleurs que sur le ".pdf" de départ,..

MErci encore,;..smile.gif

 

Civil 3D 2025 - COVADIS_18.3b

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites
  • 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.

×
 Partager
Aller sur la liste des sujets
×
×
  • 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é