Modification de routine : sélection des entités par rectangle et plus

RémiW · le 10 octobre 2017

Bonjour à toutes et à tous !

Je me permets de solliciter la communauté CADxp afin de modifier une routine existante que j'ai trouvée en me promenant sur Google. (Merci beaucoup Serge Camiré)

Le code existant permet de créer un tableau recensant des lignes contenues dans des calques filtrés par préfixes.

Deux colonnes sont créées, une avec le nom du calque et l'autre avec la somme des longueurs de lignes correspondantes.

Cette fonction est impeccable pour moi, j'ai déjà entamé la personnalisation du code.

Malheureusement, mon piètre niveau en lisp ne me permet pas d'adapter le code afin d'en modifier les caractéristiques suivantes :

- J'aimerais pouvoir sélectionner la zone de dessin à prendre en compte avec un rectangle (englobant). Pour le moment la routine analyse tout le dessin et cela n'est pas pratique.

- J'aimerais aussi que les valeurs affichées dans la colonne des longueurs cumulées soient au format "0.00" (je travaille sur un dessin en mm mais je désire des valeurs en m, j'ai déjà ajouté un facteur 0.001 aux valeurs à retourner)

Quelqu'un serait-il en mesure de m'aider afin de modifier les points ci-dessus ?

Dans tous les cas, merci de m'avoir lu :)

 
;;; Dessine un tableau illustrant la liste des calques et les linéaires de modèles filtrés (en ModelSpace)
(vl-load-com)


(defun c:TAB (

/ acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 

  LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS 

  Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau 

  ) 



  ;; ======================================================================================================================

  ;; Personnalisation

  ;; ======================================================================================================================



  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules

  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z

  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles

  (setq filteredLayers "_RUPT_*")  

  (setq filteredObjets "*line")  


  ;; Taille du tableau

  (setvar "TEXTSIZE" 300.0) 

  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte

  (setq RowHeight (* 2 textsize))

  (setq ColWidth (* 10 RowHeight))		; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes Largeur des colonnes

  ;;(setq ColHeight (* 120.0 RowHeight))

  (setq LineWeightThick acLnWt015)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightMedium acLnWt015)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightNone acLnWt015)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)




  ;; ======================================================================================================================

  ;; Ne pas modifier la suite du programme

  ;; ======================================================================================================================


  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules

  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules



  (setq acadObject (vlax-get-acad-object))

  (setq ThisDrawing (vla-get-ActiveDocument acadObject))

  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))

  (setq vlaLayers (vla-get-Layers ThisDrawing))

  (setq LayerCount (vla-get-count vlaLayers))


  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))

  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS

  (setq vlaPoint3D (PointToVariant Point3D_WCS))


  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)

  ;; dont les paires sont (LayerName Count)

  (setq Resultats nil)

  (setq layerNames nil)

  (vlax-for vlaLayer vlaLayers

     (setq layerName (vla-get-name vlaLayer))

     (setq lcLayerName (strcase layerName t))  ; Minuscules

     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))

  )

  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant

  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))


  (vlax-for vlaObject ModelSpace



     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)

              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)

         )

     (progn

        (setq endPt (vlax-curve-getEndParam vlaObject))

        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))

        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))

        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 

     ))

  )

  (setq NumRows (length layerNames));; Nombre de lignes en fonction du nombre de calques

  (setq NumRows (+ NumRows 2));; Ajout 2 lignes de titre

  ;;(setq NumColumns 2)

  (setq NumColumns 2) ;; Nombre de colonne

  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))


  ;; Ligne 0

  (setq row 0)

  (setq column 0)

  ;;(SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (setvar "textsize" 3) ;; changement ecriture taille du texte dans les cellules

  ;; Ligne 1, colonne 0

  (setq row 1)

  (setq column 0)

  (SetCellProperties vlaTableau row column "Modèle" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Ligne 1, colonne 1

  (setq row 1)

  (setq column 1)

  (SetCellProperties vlaTableau row column "Linéaires (m)" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Lignes de résultat

  (setq i 0)

  (setq n (length layerNames)) ;;Ecriture des lignes du filtre

  (setq Total 0.0)

  (while (< i n);remplacer 4 par n

     (setq Resultat (nth i Resultats))

     (setq row (+ i 2))


     ;; Calques

     (setq column 0)

     (setq layerName (strcase (car Resultat)))

     (SetCellProperties vlaTableau row column layerName textsize acMiddleCenter nil)


     ;; Linéaires des modèles

     (setq column 1)

     (setq perimeter (cdr Resultat))

     (setq Total (+ Total perimeter))

     (SetCellProperties vlaTableau row column (rtos (* perimeter 0.001)) textsize acMiddleCenter nil)

     (setq i (1+ i))

  ) 

)



(defun SetCellProperties (

  vlaTableau Row Column Texte TextHeight Alignment LineWeightPair

  )

  ;; Gère les propriétés populaires des cellules d'un tableau

  ;;    vlaTableau Row Column : Obligatoire, les autres sont facultatifs

  ;;    Row, Column : INT, base 0

  ;;    Alignment: INT, 

  ;;    LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur)

  ;; Support pour Acad2006 et Acad2009

  (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair)))

  (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment))

  (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight))

  (if Texte

     (if vla-SetCellValue 

        (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009

        (vla-SetText vlaTableau Row Column Texte)      ; AutoCAD 2006

     )

  )

)


;;; PointToVariant

;;; Conversion de Point2D ou Point3D en variant

(defun PointToVariant (

  point

/ arraySpace sArray

  )

  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))

  (setq sArray (vlax-safearray-fill arraySpace point))

  (vlax-make-variant sArray)

)

Tramber · le 10 octobre 2017

Remplace l'expression complète (vlax-for vlaObject ModelSpace .... )

Par :

(if (ssget)
 (progn
   (vlax-for vlaObject (setq sel (vla-get-ActiveSelectionSet(vla-get-ActiveDocument(vlax-get-acad-object))))
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)

              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)

         )

     (progn

        (setq endPt (vlax-curve-getEndParam vlaObject))

        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))

        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))

        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 

     ))
   )
   (vla-delete sel)
 ) 
)

Cela devrait marcher.

A la fin, tu peux jouer avec FIX :

(*(fix(* perimeter 0.1))0.01)

RémiW · le 10 octobre 2017

Salut Tramber,

Merci pour ta réponse super rapide !

L'arrondi des valeurs au format "0.00" dans le tableau marche super, je te remercie !

Pour ce qui est de la sélection par rectangle, il y a du mieux mais j'ai sûrement omis des détails importants dans mon explication.

La colonne des linéaires est désormais effectivement complétée avec uniquement les linéaires inclus dans le rectangle de sélection.

Cependant, la colonne des noms de calques me retourne quand même l'ensemble des calques ayant le préfixe "_RUPT_*" des lignes contenues dans l'espace objet.

Mon idée était que seuls les calques de préfixe "_RUPT_*" des lignes contenues dans le rectangle de sélection devaient s'afficher dans la première colonne.

J'espère que mon analyse est claire ^^ En tout cas c'est super sympa de prendre de ton temps pour ma question :)

RémiW · le 10 octobre 2017

Après intégration de tes suggestions, le code ressemble à ça :

;;; Dessine un tableau illustrant la liste des calques et les linéaires de modèles filtrés (en ModelSpace)
(vl-load-com)


(defun c:TAB (

/ acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 

  LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS 

  Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau 

  ) 



  ;; ======================================================================================================================

  ;; Personnalisation

  ;; ======================================================================================================================



  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules

  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z

  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles

  (setq filteredLayers "_RUPT_*")  

  (setq filteredObjets "*line")  


  ;; Taille du tableau

  (setvar "TEXTSIZE" 300.0) 

  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte

  (setq RowHeight (* 2 textsize))

  (setq ColWidth (* 10 RowHeight))             ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes Largeur des colonnes

  ;;(setq ColHeight (* 120.0 RowHeight))

  (setq LineWeightThick acLnWt015)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightMedium acLnWt015)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightNone acLnWt015)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)




  ;; ======================================================================================================================

  ;; Ne pas modifier la suite du programme

  ;; ======================================================================================================================


  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules

  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules



  (setq acadObject (vlax-get-acad-object))

  (setq ThisDrawing (vla-get-ActiveDocument acadObject))

  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))

  (setq vlaLayers (vla-get-Layers ThisDrawing))

  (setq LayerCount (vla-get-count vlaLayers))


  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))

  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS

  (setq vlaPoint3D (PointToVariant Point3D_WCS))


  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)

  ;; dont les paires sont (LayerName Count)

  (setq Resultats nil)

  (setq layerNames nil)

  (vlax-for vlaLayer vlaLayers

     (setq layerName (vla-get-name vlaLayer))

     (setq lcLayerName (strcase layerName t))  ; Minuscules

     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))

  )

  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant

  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))


  (if (ssget)
 (progn
   (vlax-for vlaObject (setq sel (vla-get-ActiveSelectionSet(vla-get-ActiveDocument(vlax-get-acad-object))))
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)

              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)

         )

     (progn

        (setq endPt (vlax-curve-getEndParam vlaObject))

        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))

        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))

        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 

     ))
   )
   (vla-delete sel)
 ) 
)

  (setq NumRows (length layerNames));; Nombre de lignes en fonction du nombre de calques

  (setq NumRows (+ NumRows 2));; Ajout 2 lignes de titre

  ;;(setq NumColumns 2)

  (setq NumColumns 2) ;; Nombre de colonne

  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))


  ;; Ligne 0

  (setq row 0)

  (setq column 0)

  ;;(SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (setvar "textsize" 3) ;; changement ecriture taille du texte dans les cellules

  ;; Ligne 1, colonne 0

  (setq row 1)

  (setq column 0)

  (SetCellProperties vlaTableau row column "Modèle" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Ligne 1, colonne 1

  (setq row 1)

  (setq column 1)

  (SetCellProperties vlaTableau row column "Linéaires (m)" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Lignes de résultat

  (setq i 0)

  (setq n (length layerNames)) ;;Ecriture des lignes du filtre

  (setq Total 0.0)

  (while (< i n);remplacer 4 par n

     (setq Resultat (nth i Resultats))

     (setq row (+ i 2))


     ;; Calques

     (setq column 0)

     (setq layerName (strcase (car Resultat)))

     (SetCellProperties vlaTableau row column layerName textsize acMiddleCenter nil)


     ;; Linéaires des modèles

     (setq column 1)

     (setq perimeter (cdr Resultat))

     (setq Total (+ Total perimeter))

     (SetCellProperties vlaTableau row column (rtos (*(fix(* perimeter 0.1))0.01)) textsize acMiddleCenter nil)

     (setq i (1+ i))

  ) 

)



(defun SetCellProperties (

  vlaTableau Row Column Texte TextHeight Alignment LineWeightPair

  )

  ;; Gère les propriétés populaires des cellules d'un tableau

  ;;    vlaTableau Row Column : Obligatoire, les autres sont facultatifs

  ;;    Row, Column : INT, base 0

  ;;    Alignment: INT, 

  ;;    LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur)

  ;; Support pour Acad2006 et Acad2009

  (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair)))

  (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment))

  (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight))

  (if Texte

     (if vla-SetCellValue 

        (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009

        (vla-SetText vlaTableau Row Column Texte)      ; AutoCAD 2006

     )

  )

)


;;; PointToVariant

;;; Conversion de Point2D ou Point3D en variant

(defun PointToVariant (

  point

/ arraySpace sArray

  )

  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))

  (setq sArray (vlax-safearray-fill arraySpace point))

  (vlax-make-variant sArray)

)

Tramber · le 10 octobre 2017

J'ai compris (car j'ai regardé très vite ces filtres) mais hélas je dois abandonner pour ce soir.

Sauf si je reviens... :rolleyes:

Sinon à demain !

Lingolsheim. Si ca tombe, t'as juste un prendre un bus ou ton vélo pour me voir ;)

RémiW · le 10 octobre 2017

Ah c'est nickel si j'ai été assez clair !

Et bien si tu ne reviens plus ce soir, passe une bonne soirée :)

Effectivement, le monde du lisp est tout petit apparemment ! Ou alors ce sont les sticks et la Météor qui poussent particulièrement à la programmation ^^

Olivier Eckmann · le 10 octobre 2017

Bonsoir,

juste avant la ligne

 (setq NumRows (length layerNames));; Nombre de lignes en fonction du nombre de calques

tu ajoutes ça

  (setq layernames nil Result nil)
  (foreach oTab Resultats
	(if (> (cdr oTab) 0)
  	(progn
  	(setq layernames (append layerNames (list (car oTab))))
  	(setq Result (append Result (list oTab)))
  	)
	)
  )
  (setq Resultats Result)

Olivier

RémiW · le 11 octobre 2017

Bonjour Olivier,

J'ai bien ajouté les lignes de code suggérées et tout fonctionne à merveille. C'est impeccable !

Merci beaucoup à vous deux, Tramber et Olivier !

RémiW · le 11 octobre 2017

Je vais me permettre d'abuser encore un petit peu de vos connaissances... ^^

Est-ce possible de mettre en place une mise en forme du fond de cellule du tableau en fonction de son contenu ?

Je m'explique :

Le but serait de colorer le fond de chaque cellule de la première colonne en fonction de son contenu (nom du calque) :

Si le nom du calque contient "*Type1*", alors colorer le fond de cellule en Jaune

Si le nom du calque contient "*Type2*", alors colorer le fond de cellule en Bleu

Si le nom du calque contient "*Type3*", alors colorer le fond de cellule en Vert

J'ai trouvé sur Google la fonction "vla-setcellcontentcolor" mais je dois avouer m'être perdu dans son utilisation...

La dernière version de mon code ressemble à ça :

;;; Dessine un tableau illustrant la liste des calques et les linéaires de modèles filtrés (en ModelSpace)
(vl-load-com)


(defun c:TAB (

/ acadObject column ColWidth endPt filteredLayers filteredObjets i LayerCount LayerName layerNames lcLayerName 

  LineWeightMedium LineWeightNone LineWeightThick ModelSpace n NumColumns NumRows objectName perimeter Point3D_UCS 

  Point3D_WCS Resultat Resultats row RowHeight tableau textsize ThisDrawing Total vlaLayers vlaPoint3D vlaTableau 

  ) 



  ;; ======================================================================================================================

  ;; Personnalisation

  ;; ======================================================================================================================



  ;; Liste des calques et objets désirés, séparés par des virgules, sans espace, wildcard acceptés, en minuscules ou majuscules

  ;; Exemple pour calques: "*" pour tous les calques, "E*,Z*" pour tous ceux qui commencent par E et par Z

  ;; Exemple pour objets "*" pour tous les objets "*line,circle" pour tous les objets dont le nom se termine par "line", ainsi que les cercles

  (setq filteredLayers "_RUPT_*")  

  (setq filteredObjets "*line")  

(command "-calque" "ch" "PRESENTATIONS" "")

  ;; Taille du tableau

  (setvar "TEXTSIZE" 300.0) 

  (setq textsize (getvar "textsize"))          ; Voir cette variable qui contrôle la hauteur du texte

  (setq RowHeight (* 2 textsize))

  (setq ColWidth (* 10 RowHeight))             ; Largeur totale du tableau = 2 * ColWidth puisqu'on a 2 colonnes Largeur des colonnes

  ;;(setq ColHeight (* 120.0 RowHeight))

  (setq LineWeightThick acLnWt015)             ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightMedium acLnWt015)            ; Épaisseur de la ligne de séparation (voir LWDISPLAY)

  (setq LineWeightNone acLnWt015)              ; Épaisseur de la ligne de séparation (voir LWDISPLAY)




  ;; ======================================================================================================================

  ;; Ne pas modifier la suite du programme

  ;; ======================================================================================================================


  (setq filteredLayers (strcase filteredLayers t))  ; Minuscules

  (setq filteredObjets (strcase filteredObjets t))  ; Minuscules



  (setq acadObject (vlax-get-acad-object))

  (setq ThisDrawing (vla-get-ActiveDocument acadObject))

  (setq ModelSpace (vla-get-ModelSpace ThisDrawing))

  (setq vlaLayers (vla-get-Layers ThisDrawing))

  (setq LayerCount (vla-get-count vlaLayers))


  (setq Point3D_UCS (getpoint "\nPoint d'insertion: "))

  (setq Point3D_WCS (trans Point3D_UCS 1 0))  ; Si pas en WCS

  (setq vlaPoint3D (PointToVariant Point3D_WCS))


  ;; En AutoLISP, il n'y a pas de tableau. On va se créer un faux tableau avec des clés (hash table)

  ;; dont les paires sont (LayerName Count)

  (setq Resultats nil)

  (setq layerNames nil)

  (vlax-for vlaLayer vlaLayers

     (setq layerName (vla-get-name vlaLayer))

     (setq lcLayerName (strcase layerName t))  ; Minuscules

     (if (wcmatch lcLayerName filteredLayers) (setq layerNames (cons lcLayerName layerNames)))

  )

  (setq layerNames (vl-sort layerNames '<))  ; Trier en ordre croissant

  (setq Resultats (mapcar '(lambda (x) (cons x 0.0)) layerNames))


  (if (ssget)
 (progn
   (vlax-for vlaObject (setq sel (vla-get-ActiveSelectionSet(vla-get-ActiveDocument(vlax-get-acad-object))))
     
     (if (and (wcmatch (setq objectName (strcase (vla-get-ObjectName vlaObject) t)) filteredObjets)

              (wcmatch (setq layerName (strcase (vla-get-Layer vlaObject) t)) filteredLayers)

         )

     (progn

        (setq endPt (vlax-curve-getEndParam vlaObject))

        (setq perimeter (vlax-curve-getDistAtParam vlaObject endPt))

        (setq Total (+ perimeter (cdr (assoc layerName Resultats))))

        (setq Resultats (subst (cons layerName Total) (assoc layerName Resultats) Resultats)) 

     ))
   )
   (vla-delete sel)
 ) 
)

  (setq layernames nil Result nil)
  (foreach oTab Resultats
       (if (> (cdr oTab) 0)
       (progn
       (setq layernames (append layerNames (list (car oTab))))
       (setq Result (append Result (list oTab)))
       )
       )
  )
  (setq Resultats Result)

  (setq NumRows (length layerNames));; Nombre de lignes en fonction du nombre de calques

  (setq NumRows (+ NumRows 2));; Ajout 2 lignes de titre

  ;;(setq NumColumns 2)

  (setq NumColumns 2) ;; Nombre de colonne

  (setq vlaTableau (vla-AddTable ModelSpace vlaPoint3D NumRows NumColumns RowHeight ColWidth))


  ;; Ligne 0

  (setq row 0)

  (setq column 0)

  ;;(SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (SetCellProperties vlaTableau row column "RECAPITULATIF" textsize acMiddleCenter nil)

  (setvar "textsize" 3) ;; changement ecriture taille du texte dans les cellules

  ;; Ligne 1, colonne 0

  (setq row 1)

  (setq column 0)

  (SetCellProperties vlaTableau row column "Modèle" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Ligne 1, colonne 1

  (setq row 1)

  (setq column 1)

  (SetCellProperties vlaTableau row column "Linéaires (m)" textsize acMiddleCenter (cons acHorzBottom LineWeightMedium))


  ;; Lignes de résultat

  (setq i 0)

  (setq n (length layerNames)) ;;Ecriture des lignes du filtre

  (setq Total 0.0)

  (while (< i n);remplacer 4 par n

     (setq Resultat (nth i Resultats))

     (setq row (+ i 2))


     ;; Calques

     (setq column 0)

     (setq layerName (strcase (car Resultat)))

     (SetCellProperties vlaTableau row column layerName textsize acMiddleCenter nil)


     ;; Linéaires des modèles

     (setq column 1)

     (setq perimeter (cdr Resultat))

     (setq Total (+ Total perimeter))

     (SetCellProperties vlaTableau row column (rtos (*(fix(* perimeter 0.1))0.01)) textsize acMiddleCenter nil)

     (setq i (1+ i))

  ) 

)



(defun SetCellProperties (

  vlaTableau Row Column Texte TextHeight Alignment LineWeightPair

  )

  ;; Gère les propriétés populaires des cellules d'un tableau

  ;;    vlaTableau Row Column : Obligatoire, les autres sont facultatifs

  ;;    Row, Column : INT, base 0

  ;;    Alignment: INT, 

  ;;    LineWeightPair: nil, sinon (cons "AcGridLineType enum" "acad_lweight enum"), soit (cons Position Épaisseur)

  ;; Support pour Acad2006 et Acad2009

  (if LineWeightPair (vla-SetCellGridLineWeight vlaTableau Row Column (car LineWeightPair) (cdr LineWeightPair)))

  (if Alignment (vla-SetCellAlignment vlaTableau Row Column Alignment))

  (if TextHeight (vla-SetCellTextHeight vlaTableau Row Column TextHeight))

  (if Texte

     (if vla-SetCellValue 

        (vla-SetCellValue vlaTableau Row Column Texte) ; AutoCAD 2009

        (vla-SetText vlaTableau Row Column Texte)      ; AutoCAD 2006

     )

  )

)


;;; PointToVariant

;;; Conversion de Point2D ou Point3D en variant

(defun PointToVariant (

  point

/ arraySpace sArray

  )

  (setq arraySpace (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length point)))))

  (setq sArray (vlax-safearray-fill arraySpace point))

  (vlax-make-variant sArray)

)

Un grand merci :)

Connexion

Modification de routine : sélection des entités par rectangle et plus

Messages recommandés

RémiW

Lien vers le commentaire

Partager sur d’autres sites

Tramber

Lien vers le commentaire

Partager sur d’autres sites

RémiW

Lien vers le commentaire

Partager sur d’autres sites

RémiW

Lien vers le commentaire

Partager sur d’autres sites

Tramber

Lien vers le commentaire

Partager sur d’autres sites

RémiW

Lien vers le commentaire

Partager sur d’autres sites

Olivier Eckmann

Lien vers le commentaire

Partager sur d’autres sites

RémiW

Lien vers le commentaire

Partager sur d’autres sites

RémiW

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante