Qu utilisez vous pour vos métrés ?

#21 lecrabe

ceinture rouge et blanche 8em dan

Groupe : Moderateurs
Messages : 9 446
Inscrit(e) : 10-décembre 03
LocationLoire (42) Forez

Posté 25 janvier 2021 - 13:42

Hello Perline

Dans ton message, tu signales que tu as trouve un Lisp qui separe les entites par couleur !

Je ne sais pas de quelle routine, tu parles !!

Donc je te propose la MEME routine E2LBC "de competition" que j'utilise ... MERCI Mr dlanorh !
E2LBC traite TOUTES les couleurs: ACI AutoCAD Color Index (0-256) , RGB/RVB (16 millions de couleurs) , Pantome , RAL , etc !

LA SANTE, Bye, lecrabe

;;
;; Routine: E2LBC__Entities_to_Layer_By_Color__dlanorh by dlanorh for Patrice B.
;; 
;; Move selected Entities on separate layers depending on Color
;;
;; --- Interrogation Entite/Objet en Lisp --- 
;; (entget (car (entsel)) '("*"))
;; 

(vl-load-com) 

(defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)))

(defun rh:lst2str ( lst del / str ) (setq str "")  (mapcar '(lambda (x) (setq str (strcat str x del))) lst) (vl-string-right-trim del str))

(defun rh:layer_props ( lyr lst / v ) (setq v (mapcar '(lambda (x) (vlax-get-property lyr x)) lst)))

(defun rh:strlen3 ( str ) (if (< (strlen str) 3) (while (< (strlen str) 3) (setq str (strcat "0" str))) str) str)

;; Entities to layer by color
(defun c:E2LBC ( / c_doc c_lyrs l_props ss cnt ent elst lyr l_vals cstr clst clr nlyr lobj)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        l_props (list 'truecolor 'linetype 'lineweight);Layer properties list
  );end_setq

  (prompt "\nSelect Entities : ")
  (setq ss (ssget))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  lyr (cdr (assoc 8 elst));Layer
                  l_vals (rh:layer_props (vla-item c_lyrs lyr) l_props);Layer properties
                  cstr ""
                  clst nil
            );end_setq

            (foreach x '(62 420 430) (setq clst (cons (cdr (assoc x elst)) clst)))
            (setq clr (vl-some '(lambda (x) x) clst))
            (cond ( (not clr) (setq cstr "256"))                ;No Color set (bylayer)
                  ( (and (= (type clr) 'INT) (<= clr 256))      ;ACI (0-256)
                    (setq cstr (rh:strlen3 (itoa clr)))
                  )
                  ( (= (type clr) 'STR) (setq cstr clr))        ;Color Book
                  (t (setq clr (mapcar 'itoa (LM:True->RGB clr));RGB
                           cstr (rh:lst2str (mapcar 'rh:strlen3 clr) "_")
                     );end_setq
                  )
            );end_cond
            (setq nlyr (strcat lyr "__" cstr))

            (cond ( (not (tblsearch "layer" nlyr)) (setq lobj (vla-add c_lyrs nlyr)) (mapcar '(lambda (x y) (vlax-put-property lobj x y)) l_props l_vals)))
            (vlax-put-property (vlax-ename->vla-object ent) 'layer nlyr)
          );end_repeat
        )
        (t (alert "NO Entities Selected ! "))
  );end_cond

  (princ) 
);end_defun

Autodesk Expert Elite Team

Retour en haut of the page up there ^

#22 obzo

ceinture blanche

Groupe : Membres
Messages : 1
Inscrit(e) : 08-février 19

Posté 28 janvier 2021 - 11:18

lecrabe, le 25 janvier 2021 - 13:42 , dit :

;;
;; Routine: E2LBC__Entities_to_Layer_By_Color__dlanorh by dlanorh for Patrice B.
;; 
;; Move selected Entities on separate layers depending on Color
;;
;; --- Interrogation Entite/Objet en Lisp --- 
;; (entget (car (entsel)) '("*"))
;; 

(vl-load-com) 

(defun LM:True->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(8 16 24)))

(defun rh:lst2str ( lst del / str ) (setq str "")  (mapcar '(lambda (x) (setq str (strcat str x del))) lst) (vl-string-right-trim del str))

(defun rh:layer_props ( lyr lst / v ) (setq v (mapcar '(lambda (x) (vlax-get-property lyr x)) lst)))

(defun rh:strlen3 ( str ) (if (< (strlen str) 3) (while (< (strlen str) 3) (setq str (strcat "0" str))) str) str)

;; Entities to layer by color
(defun c:E2LBC ( / c_doc c_lyrs l_props ss cnt ent elst lyr l_vals cstr clst clr nlyr lobj)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        l_props (list 'truecolor 'linetype 'lineweight);Layer properties list
  );end_setq

  (prompt "\nSelect Entities : ")
  (setq ss (ssget))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq ent (ssname ss (setq cnt (1- cnt)))
                  elst (entget ent)
                  lyr (cdr (assoc 8 elst));Layer
                  l_vals (rh:layer_props (vla-item c_lyrs lyr) l_props);Layer properties
                  cstr ""
                  clst nil
            );end_setq

            (foreach x '(62 420 430) (setq clst (cons (cdr (assoc x elst)) clst)))
            (setq clr (vl-some '(lambda (x) x) clst))
            (cond ( (not clr) (setq cstr "256"))                ;No Color set (bylayer)
                  ( (and (= (type clr) 'INT) (<= clr 256))      ;ACI (0-256)
                    (setq cstr (rh:strlen3 (itoa clr)))
                  )
                  ( (= (type clr) 'STR) (setq cstr clr))        ;Color Book
                  (t (setq clr (mapcar 'itoa (LM:True->RGB clr));RGB
                           cstr (rh:lst2str (mapcar 'rh:strlen3 clr) "_")
                     );end_setq
                  )
            );end_cond
            (setq nlyr (strcat lyr "__" cstr))

            (cond ( (not (tblsearch "layer" nlyr)) (setq lobj (vla-add c_lyrs nlyr)) (mapcar '(lambda (x y) (vlax-put-property lobj x y)) l_props l_vals)))
            (vlax-put-property (vlax-ename->vla-object ent) 'layer nlyr)
          );end_repeat
        )
        (t (alert "NO Entities Selected ! "))
  );end_cond

  (princ) 
);end_defun

Merci pour le Lisp, il y aurait un paramètre pour récupérer les longueurs par exemple on fait un bloc de HEA 100 un autre de 140 avec la possibilité des les étirer et on pourrait avoir les lgs cumulées des hea 100 et hea 140 dans les tableaux ? J'avais trouvé un bloc Pline_block mais j'ai pas trop compris comment ça marche

Retour en haut of the page up there ^

#23 Perline

Member

Groupe : Membres
Messages : 10
Inscrit(e) : 25-janvier 21

Posté 28 janvier 2021 - 13:39

Oh là là le crabe :wub:

, merci pour toutes ces routines!

voilà où j'avais trouvé la routine mdfc
https://cadxp.com/to...__1#entry291050

Du coup, avec tout ça un petit copié collé vers word, transcription en tableau et il y a de quoi traviller (quand il n'y a pas de "surprise" d'élévation HAHA)

Retour en haut of the page up there ^

#24 lecrabe

ceinture rouge et blanche 8em dan

Groupe : Moderateurs
Messages : 9 446
Inscrit(e) : 10-décembre 03
LocationLoire (42) Forez

Posté 04 février 2021 - 09:52

Hello

Au fait j ai oublie une excellente routine "LayerCount" de Lee-Mac pour compter les objets selectionnes par Calque !
C tres pratique quand tu as UN SEUL type d objet sur certains calques ...

LA SANTE, Bye, lecrabe

 
;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/object-count-per-layer/td-p/7619771
;; 

;; Layer Count  -  Lee Mac
;;
;; Prints a report of the number of objects on each layer in a drawing

(defun c:LayerCount ( / lst ss )
  (if (ssget)
	    (progn
		    (vlax-for obj (setq ss (vla-get-ActiveSelectionSet (vla-get-activedocument (vlax-get-acad-object))))
		            (setq lst (layercount:assoc++ (vla-get-layer obj) lst))
		            (if
		                (and
		                    (= "AcDbBlockReference" (vla-get-objectname obj))
		                    (= :vlax-true (vla-get-hasattributes obj))
		                )
		                (foreach att (vlax-invoke obj 'getattributes)
		                    (setq lst (layercount:assoc++ (vla-get-layer att) lst))
		                )
		            )
		    )

	    (vla-delete ss)
	    (princ (layercount:padbetween "\n\n" "" "-" 62))
	    (princ (layercount:padbetween "\nLayer" "Objects" " " 61))
	    (princ (layercount:padbetween "\n" "" "-" 61))
	    (foreach itm (vl-sort lst '(lambda ( a b ) (> (cdr a) (cdr B))))
	        (princ (layercount:padbetween (strcat "\n" (car itm)) (itoa (cdr itm)) "." 61))
	    )
	    (princ (layercount:padbetween "\n" "" "-" 61))
	    (princ (layercount:padbetween "\nTotal" (itoa (apply '+ (mapcar 'cdr lst))) "." 61))
	    (princ (layercount:padbetween "\n" "" "-" 61))
	    (textpage)
	    (princ)
	)
    )
  ) 

(defun layercount:assoc++ ( key lst / itm )
    (if (setq itm (assoc key lst))
        (subst (cons key (1+ (cdr itm))) itm lst)
        (cons  (cons key 1) lst)
    )
) 

(defun layercount:padbetween ( s1 s2 ch ln )
    (
        (lambda ( a b c )
            (repeat (- ln (length B) (length c)) (setq c (cons a c)))
            (vl-list->string (append b c))
        )
        (ascii ch)
        (vl-string->list s1)
        (vl-string->list s2)
    )
) 
      
(vl-load-com) (princ)

Autodesk Expert Elite Team

Retour en haut of the page up there ^

#25 rebcao

ceinture rouge et blanche 8em dan

Groupe : Membres
Messages : 7 301
Inscrit(e) : 25-août 04
LocationSELESTAT

Posté 04 février 2021 - 16:24

Bonjour,

J'ai développé depuis pas mal de temps, une palettes d'outils qui reprend plusieurs fonctions :

1. Calcul de surfaces à partir d'objets fermés, via SCANDXF et un blocs avec ATTRIBUTS
2. Métrés linéaires via SCANDXF et EXCEL, de manière optimisé
3. Quantitatifs basés sur des blocs avec et sans ATTRIBUTS

Le tout agrémenté par plusieurs vidéos YOUTUBE...

Et bien sur, 100% COMPATIBLE avec les versions LT !

Christian

Formateur, Consultant Expert AutoCAD, REVIT MEP, INVENTOR, télécharger des Supports de Cours AutoCAD, des Outils AutoCAD...
cad123 @ wanadoo.fr (enlever les espaces de part et d'autre de @)