Longueurs cumulées /calque /zone vers tableau

[Azerty]

Bonjour à tous.

 

Avant d'expliquer ma "demande", je me permets de préciser que j'ai déjà pas mal cherché sur le forum et ailleurs sur la toile. J'en suis à une quinzaine de codes lisp téléchargés et essayés ... mais je ne trouve rien de convainquant.

 

 

Merci d'imaginer un plan couvrant plusieurs communes (donc plusieurs Km)

Ainsi qu'un nombre important de cadres correspondant à XX folios (impressions au 200e).

Ma finalité est d'obtenir un tableau indiquant les longueurs cumulées des polylignes de chaque CALQUE et de chaque CADRE

 

Voici la liste des "problèmes" que je rencontre :

- plusieurs codes avec sélection se "contentent" d'afficher les infos sans les enregistrer

- tableau_perimetre génère un tableau comme je le souhaite, mais sur tout le dessin et non par sélection

- l'outil extraction de données d'autocad est trop lourd, au vue de la répétition du procédé

- aucun lisp ne génère un CSV et un tableau dans autocad, c'est soit l'un soit l'autre

- dans tous les cas, il est nécessaire d'ajuster les polylignes aux cadres (après réflexion j'envisage de dupliquer/décaler 2 fois le plan et de travailler en quinconce : folios pairs et folios impairs pour me faciliter la vie) mais un pro du codage a peut-être déjà inventé une délimitation par sélection de zone.

 

 

Bref, avez-vous déjà fait face à ces problèmes ? Et si oui quelles solutions auriez-vous à me proposer ?

Il existe peut-être un lisp qui correspond + à mes besoins ...

Toute aide est la bienvenue !

[lecrabe]

Hello

 

J'ai un "bon petit" VLisp de Gilles "TLEN_PL_LAY.lsp" qui affiche la longueur de toutes les Polylignes et ce par calque et avec le total general ! ... Cela pourra eventuellement te servir ou etre un point de depart !?

 

Et si tu charges aussi la Super-Routine "Special_Selection" de Gilles, alors AVANT un petit coup de SSOF (Fenetre normale gauche-droite) ou SSOC (fenetre capturante droite-gauche) puis APRES TLEN_PL_LAY et ainsi tu as le Total des Longueurs par calque pour UN Cadre (UNE Polyligne en fait) ...

 

Merci Gilles, Bye, lecrabe

 

;; 
;; Routine: TLEN_PL_LAY par GC
;; 
;; Total des longueurs par CALQUE 
;; 
;; ATTENTION: la routine PLANTE si on selectionne des Polylignes de type: 3D Maillage / 3D Mesh
;; Car la propriete vla-get-area ou vla-get-length n'existe pas pour ces Entites ... 
;; Il faudrait AFFINER le filtre de selection ... 
;; 

(vl-load-com) 

(defun c:TLEN_PL_LAY (/ ent ele lst sel res tot filtre) 

 (setq filtre 'layer) ; Layer pour les calques, Color pour les couleurs, Linetype pour les types de lignes 
;; ConstantWidth : Non Fonctionnel 

 (and (ssget (list (cons 0 "*POLYLINE")))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
       (if (setq ele (assoc (vlax-get ent filtre) lst))
         (setq lst (subst (list (car ele) (cons (vla-get-length ent) (cadr ele))) ele lst))
         (setq lst (cons (list (vlax-get ent filtre) (list (vla-get-length ent))) lst))
       )
     )
     (vla-delete sel)
     (setq tot 0)
     (mapcar '(lambda(x)
               (setq tot (+ tot (setq res (apply '+ (cadr x)))))
               (princ "\nTotal Longueur des Polyligne(s) type ")
               (princ filtre)
               (princ " --> ")
               (princ (car x))
               (princ (strcat " : " (rtos res)))
             )
             (vl-sort lst '(lambda(a B)(< (car a) (car B))))
     ) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; (padLeft (rtos (car item) 2 2) 6) 
     (princ (strcat "\nTotal : " (rtos tot))) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

   )
 )
 (princ)
) 

[DenisHen]

Salut à tous.

 

Tu peux t'en inspirer aussi :

;;;*****************************************************************************************
;;; Calcul les sommes des Polylignes depuis une liste de calque (issu de SomPoly de (gile)) 
;;;*****************************************************************************************
(defun c:DHSomPoly (/ List1@ Value1$ Som calque LstCalq calque Dist)
 (princ "\nSomme des Polylignes par calques")
 (if (not *DHSomPolye@)                ;Unique global variable name to store dialog info
   (setq *DHSomPoly@ (list nil "" ""))
 ) ;_ Fin de if
 (setq Value1$ nil
       List1@ nil
       Som 0
 ) ;_ Fin de setq
 (while (setq lay (tblnext "LAYER" (not lay)))
   (if (not (wcmatch (cdr (assoc 2 lay)) "*|*"))
     (setq List1@ (cons (cdr (assoc 2 lay)) List1@))
   ) ;_ Fin de if
 ) ;_ Fin de while
 (setq List1@ (vl-sort List1@ '<))
 (setq Dcl_Id% (load_dialog "SelectCalque.dcl"))
 (new_dialog "SelectCalque" Dcl_Id%)   ; Set Dialog Initial Settings
 (set_tile "Title" "Sélection de calques")
 (set_tile_list "List1" List1@ Value1$) ;*Included
 ;; Dialog Actions
 (action_tile "List1" "(set_multilist_value \"List1@\" \"Value1$\")")
 ;;*Included
 (setq Return# (start_dialog))
 ;; Unload Dialog
 (unload_dialog Dcl_Id%)
 (setq LstCalq Value1$)
 (foreach calque LstCalq
   (setq Dist (polyLengthByLayer calque))
   (princ
     (strcat "\nLe calque '" calque "' contient " (rtos Dist 2 1) "m") ;_ Fin de strcat
   ) ;_ Fin de if
   (setq Som (+ Som Dist))
 ) ;_ Fin de foreach
 (princ (strcat "\nPour un total de : " (rtos Som 2 1) "m"))
 (princ)
) ;_ Fin de defun
;;;
;;;
(defun polyLengthByLayer (layer / len ss)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 ) ;_ Fin de or
 (setq len 0)
 (if
   (ssget "_X"
          (list '(0 . "lwpolyline") (cons 8 layer) (cons 410 "Model"))
   ) ;_ Fin de ssget
    (progn (vlax-for pl (setq ss (vla-get-ActiveSelectionSet *acdoc*))
             (setq len (+ len (vla-get-Length pl)))
           ) ;_ Fin de vlax-for
           (vla-Delete ss)
    ) ;_ Fin de progn
 ) ;_ Fin de if
 len
) ;_ Fin de defun
;;;
(defun set_tile_list (KeyName$ ListName@ Selected / Item)
 (start_list KeyName$ 3)
 (mapcar 'add_list ListName@)
 (end_list)
 (foreach Item (if (listp Selected)
                 Selected
                 (list Selected)
               ) ;_ Fin de if
   (if (member Item ListName@)
     (set_tile
       KeyName$
       (itoa (- (length ListName@) (length (member Item ListName@))))
     ) ;_ Fin de set_tile
   )                                   ;if
 )                                     ;foreach
)                                       ;defun set_tile_list
;;;
(defun set_list_value (SentList$ SentVar$ / SaveVar$ SubList@)
 (setq SubList@ (eval (read SentList$)))
 (setq SaveVar$ (eval (read SentVar$)))
 (set (read SentVar$) (nth (atoi $value) SubList@))
 (if (= (eval (read SentVar$)) "")
   (progn (set (read SentVar$) SaveVar$)
          (set_tile_list $key SubList@ SaveVar$)
   )                                   ;progn
 )                                     ;if
 (princ)
)                                       ;defun set_list_value
;;;
(defun set_multilist_value (SentList$ SentVar$ / SubList@)
 (setq SubList@ (eval (read SentList$)))
 (set (read SentVar$) (list (nth (atoi $value) SubList@)))
 (setq $value (substr $value (+ (strlen (itoa (atoi $value))) 2)))
 (while (/= $value "")
   (set (read SentVar$)
        (append (eval (read SentVar$))
                (list (nth (atoi $value) SubList@))
        ) ;_ Fin de append
   )                                   ;set
   (setq $value (substr $value (+ (strlen (itoa (atoi $value))) 2)))
 )                                     ;while
)                                       ;defun set_multilist_value
;;;
;;;
;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq tmp  (vl-filename-mktemp "tmp.dcl")
       file (open tmp "w")
 ) ;_ Fin de setq
 (write-line (strcat "ListBox:dialog{label=\"" title "\";") file)
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 ) ;_ Fin de if
 (write-line
   (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
         ((= 1 flag) "spacer;:list_box{key=\"lst\";")
         (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   ) ;_ Fin de cond
   file
 ) ;_ Fin de write-line
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 ) ;_ Fin de if
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 ) ;_ Fin de action_tile
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
) ;_ Fin de defun

 

Attention, mon lisp, merci à Maître (gile), ne travaille QUE dans l'espace "Objet"...

 

La commande est : DHSomPoly

[bonuscad]

Bonjour,

 

As tu trouvé celui-là, et la tu essayé?

[Azerty]

Merci pour vos suggestions de code.

Mais je ne sais pas l'adapter moi-même, donc je vais voir.

 

Pour l'instant j'ai + vite fait de couper / coller dans un autre dessin / exécuter tableau_perimetre / couper / recopier ...

[lecrabe]

Hello Bruno

 

ZUT j'ai un probleme avec TA routine !

... Tests avec AutoCAD MAP 2018 et MAP 2014 ...

 

Commande: LENGTH2CELL&FIELD

 

Traiter jeu de sélection [Existant/Nouveau] : n

 

Sélectionner des objets: Spécifiez le coin opposé: 12 trouvé(s)

 

Sélectionner des objets:

 

Point d'insertion haut gauche du tableau:

Hauteur du texte :

Largeur des cellules: ; erreur: no function definition:

 

Commande:

 

Bye, lecrabe

[Azerty]

J'ai répondu sans actualiser : je n'ai vu la réponse de bonuscad qu'après.

Ça semble se rapprocher de ce que je recherche :-)

Mais j'ai le même message d'erreur (erreur: no function definition sur toto MAP 2014)

La fin du fil de discussion évoque la version finale sur ton site "perso" (enfin je suppose)

Mais le lien est down ...

[bonuscad]

Hello Bruno

 

ZUT j'ai un probleme avec TA routine !

... Tests avec AutoCAD MAP 2018 et MAP 2014 ...

 

Commande: LENGTH2CELL&FIELD

 

Traiter jeu de sélection [Existant/Nouveau] <Existant>: n

 

Sélectionner des objets: Spécifiez le coin opposé: 12 trouvé(s)

 

Sélectionner des objets:

 

Point d'insertion haut gauche du tableau:

Hauteur du texte <5.00>:

Largeur des cellules: <Ortho actif> ; erreur: no function definition: <

 

Commande:

 

Bye, lecrabe

 

Je suis sous MAP2014 et je vois pas...

La fonction (vl-load-com) a bien été lancé, car la ligne juste après "Largeur des cellules: " est:

(setq tmp_file (vl-filename-mktemp "metre.dcl"))

pour écrire le dcl de la boite de dialogue.

D'ailleurs que retourne cette ligne si tu la copie-colle directement en ligne de commande?

 

Edit: j'ai copier-coller le code donné en lien et effectivement des bbcode foutent le bordel (ça date de 2009) .

 

Le plus simple je reposte le code de puis le fichier de mon PC

 

(vl-load-com)
(defun c:Length2Cell&Field ( / js AcDoc Space all_path end_pos id_path fonts_path file_shx nw_style
                              oldim oldlay ins_pt_cell h_t w_c ename_cell n_row n_column n ename
                              tmp_file dcl_file Id_obj q_lay q_col q_ltyp q_weig n_column lst_idcolumn do_it dcl_id nb_c)
 (or
   (setq js (ssget "_I"))
   (setq js (ssget "_P"))
 )
 (cond
   (js
     (sssetfirst nil js)
     (initget "Existant Nouveau _Existent New")
     (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New")
       (progn (sssetfirst nil nil) (setq js (ssadd) js (ssget)))
     )
   )
   (T (setq js (ssget)))
 )
 (cond
   (js
     (setq
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (cond
       ((null (tblsearch "LAYER" "Tableaux-Métrés"))
         (vla-add (vla-get-layers AcDoc) "Tableaux-Métrés")
       )
     )
     (cond
       ((null (tblsearch "STYLE" "Texte-Métré"))
         (setq all_path (getenv "ACAD") j 0)
         (while (setq end_pos (vl-string-position (ascii ";") all_path))
           (setq id_path (substr all_path 1 end_pos))
           (if (wcmatch (strcase id_path) "*FONTS*")
             (setq fonts_path (strcat id_path "\\"))
           )
           (setq all_path (substr all_path (+ 2 end_pos)))
         )
         (setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8))
         (if (not file_shx)
           (setq file_shx "txt.shx")
         )
         (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Métré"))
         (mapcar
           '(lambda (pr val)
             (vlax-put nw_style pr val)
           )
           (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
           (list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
         )
         (command "_.ddunits"
           (while (not (zerop (getvar "cmdactive")))
             (command pause)
           )
         )
       )
     )
     (setq
       oldim (getvar "dimzin")
       oldlay (getvar "clayer")
     )
     (setvar "dimzin" 0) (setvar "clayer" "Tableaux-Métrés")
     (initget 9)
     (setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: "))
     (initget 6)
     (setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: ")))
     (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
     (initget 7)
     (setq w_c (getdist ins_pt_cell "\nLargeur des cellules: "))
     (setq
       tmp_file	 (vl-filename-mktemp "metre.dcl")
       dcl_file (open tmp_file "w")
     )
     (write-line
       "Length2CellField : dialog {
         label = \"Choix des colonnes à inscrire\";
           : column {
             : toggle {
               label    = \"Identification des objets\";
               mnemonic = \"I\";
               key      = \"Id_obj\";
             }
             : toggle {
               label    = \"caLque de l'objet\";
               mnemonic = \"L\";
               key      = \"q_lay\";
               }
             : toggle {
               label    = \"Couleur de l'objet\";
               mnemonic = \"C\";
               key      = \"q_col\";
               }
             : toggle {
               label    = \"Type de ligne de l'objet\";
               mnemonic = \"T\";
               key      = \"q_ltyp\";
               }
             : toggle {
               label    = \"Epaisseur de ligne de l'objet\";
               mnemonic = \"E\";
               key      = \"q_weig\";
               }
             }
           ok_cancel_err;
         }"
       dcl_file
     )
     (close dcl_file)
     (setq Id_obj "0" q_lay "1" q_col "0" q_ltyp "0" q_weig "0" n_column 1 lst_idcolumn '("Longueur") do_it '((strcat ">%)." typ_measure " \\f \"%lu6\">%")))
     (setq dcl_id (load_dialog tmp_file))
		(setq what_next 2)
		(while (< 1 what_next)
			(if (not (new_dialog "Length2CellField" dcl_id)) (exit))
			(set_tile "Id_obj" Id_obj)
			(set_tile "q_lay" q_lay)
			(set_tile "q_col" q_col)
			(set_tile "q_ltyp" q_ltyp)
			(set_tile "q_weig" q_weig)
			(set_tile "error" "")
			(action_tile "Id_obj" "(setq Id_obj $value)")
			(action_tile "q_lay" "(setq q_lay $value)")
			(action_tile "q_col" "(setq q_col $value)")
			(action_tile "q_ltyp" "(setq q_ltyp $value)")
			(action_tile "q_weig" "(setq q_weig $value)")
			(action_tile "accept" "(done_dialog 1)")
			(action_tile "cancel" "(done_dialog 0)")
			(setq what_next (start_dialog))
		)
		(unload_dialog dcl_id)
		(vl-file-delete tmp_file)
     (foreach z '(q_weig q_ltyp q_col q_lay Id_obj)
       (if (not (zerop (atoi (eval Z))))
         (setq
           n_column (1+ n_column)
           lst_idcolumn
           (cons
             (cond
               ((eq z 'ID_OBJ) "ID Objet")
               ((eq z 'Q_LAY) "Calque")
               ((eq z 'Q_COL) "Couleur")
               ((eq z 'Q_LTYP) "Type Ligne")
               ((eq z 'Q_WEIG) "Epaisseur Ligne")
             )
             lst_idcolumn
           )
           do_it
           (cons
             (cond
               ((eq z 'ID_OBJ) ">%).ObjectName \\f \"%tc4\">%")
               ((eq z 'Q_LAY) ">%).Layer \\f \"%tc4\">%")
               ((eq z 'Q_COL) ">%).TrueColor \\f \"%tc4\">%")
               ((eq z 'Q_LTYP) ">%).Linetype \\f \"%tc4\">%")
               ((eq z 'Q_WEIG) ">%).Lineweight \\f \"%.2f mm%lw1\">%")
             )
             do_it
           )
         )
       )
     )
     (setq ename_cell (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 (sslength js)) n_column (+ h_t (* h_t 0.25)) w_c))
     (setq n_row 2 n_column -1)
     (vla-SetText ename_cell 0 0 "Tableau Récapitulatif de Métré")
     (vla-SetCellTextStyle ename_cell 0 0 "Texte-Métré")
     (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5))
     (vla-SetCellAlignment ename_cell 0 0 5)
     (foreach string lst_idcolumn
       (vla-SetText ename_cell 1 (setq n_column (1+ n_column)) string)
       (vla-SetCellTextStyle ename_cell 1 n_column "Texte-Métré")
       (vla-SetCellTextHeight ename_cell 1 n_column (vlax-make-variant h_t 5))
       (vla-SetCellAlignment ename_cell 1 n_column 5)
     )
     (setq n_column -1)
     (repeat (setq n (sslength js))
       (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))))
       (foreach typ_measure '("Length" "ArcLength" "Circumference")
         (if (vlax-property-available-p ename (read typ_measure))
           (progn
             (foreach el do_it
               (vla-SetText ename_cell n_row (setq n_column (1+ n_column))
                 (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) (eval el))
               )
               (vla-SetCellTextStyle ename_cell n_row n_column "Texte-Métré")
               (vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5))
               (vla-SetCellAlignment ename_cell n_row n_column 6)
             )
             (setq n_row (1+ n_row) n_column -1)
           )
         )
       )
     )
     (setq n_column (1- (length lst_idcolumn)))
     (cond
       ((zerop n_column) (setq nb_c "A"))
       ((eq n_column 1) (setq nb_c "B"))
       ((eq n_column 2) (setq nb_c "C"))
       ((eq n_column 3) (setq nb_c "D"))
       ((eq n_column 4) (setq nb_c "E"))
       ((eq n_column 5) (setq nb_c "F"))
     )
     (vla-SetText ename_cell n_row n_column
       (strcat "Total= " "%<\\AcExpr (Sum(" nb_c "3:" nb_c  (itoa n_row) ")) \\f \"%lu6\">%")
     )
     (vla-SetCellTextStyle ename_cell n_row (1- (length lst_idcolumn)) "Texte-Métré")
     (vla-SetCellTextHeight ename_cell n_row (1- (length lst_idcolumn)) (vlax-make-variant h_t 5))
     (vla-SetCellAlignment ename_cell n_row (1- (length lst_idcolumn)) 6)
     (vlax-release-object ename_cell)
     (vlax-release-object Space)
     (setvar "dimzin" oldim) (setvar "clayer" oldlay)
   )
   (T
     (princ "\nSélection vide!")
   )
 )
 (prin1)
)

Modifié le 10 novembre 2017 par bonuscad

[lecrabe]

Hello - Test sous MAP 2014 x64

 

Commande: (setq tmp_file (vl-filename-mktemp "metre.dcl"))

"C:\\Users\\ZAdmin\\AppData\\Local\\Temp\\metre006.dcl"

 

Je t'envoie en MP mon DWG de Test ...

 

-------------------------------------------------------------

C BON , ca marche avec TON Code de TON message precedent !!!

-------------------------------------------------------------

!! MERCI BEAUCOUP !!

-------------------------------------------------------------

 

Bye, lecrabe

[Azerty]

14h39 : avec le code "corrigé" ça marche bien.

J'ai plus qu'à lier tout ça à un tableau excel pour arriver à mes fins

 

... et à ajuster 70 folios mais ça je m'en doutais ^^