[Résolu] [AutoCad 2014] Listing Volume solide 3D par calque

[-Ced-]

Bonjour,

J'ai un projet avec des solides répartis par calque en fonction de leur élévation et différencié par couleur en fonction du matériau.

J'aimerais savoir s'il existe une méthode pour obtenir un fichier excel dans lequel je puisse avoir les volumes de mes solides 3D contenant dans mes différents calques ?

 

Un sorte de tableau excel avec un ligne par calque et le volume de mes solides present dessus (idéalement s'il y avait la couleur du solide ça serait parfait)

 

Merci

 

Edit : Via la fonctionnalité "extraire des données" je n'arrive pas à obtenir le volume des solides (cette fonction me permet d'avoir un ligne par solide en indiquant son calque et sa couleur mais hélas pas son volume...)

[lecrabe]

Hello

 

Une idee !

 

SVP tu regardes ce sujet :

http://cadxp.com/topic/38738-3d-champ-volume-et-surface-dun-objet-3d-volumique/

 

Et apres si tu essayais d'extraire le contenu des MTextes ...

qui sont en fait des champs dynamiques refletant le volume de tes 3D Solid AutoCAD ...

 

Bye, Pat

[Tramber]

Malin. Merci pour la lecture, animal de bord de mer.

[-Ced-]

Bonjour,

J'ai trouvé une solution à mon problème sur ce site : http://www.civilmania.com/forum/topic/8161-metre-autocad-vers-excel/

 

En passant par une vba

 

Je vous cite la réponse de gcoot :

Une petite macro VBA pour autocad :

 

Renseigne sur différent objets de base mais pas d'extraction des données de blocs

ça fait un moment que je m'en sert, c'est un peu brut comme résultat mais ça permet ensuite une grande souplesse sur excel (tri...)

 

 

Sub MOP()

Dim xlApp As Object

On Error GoTo fin

Set xlApp = GetObject(, "Excel.Application")

Dim strRep As String

Dim strTest As String

Dim i As Long

Dim Haut As Double

Dim PNum As Integer

Dim oObj As AcadObject

Dim oLay As AcadObject

Dim sLay As String

Dim ssObj As AcadSelectionSet

Dim sType As String

Dim sValue As String

Dim pBase As Variant

Dim oTmp As Acad3DSolid

 

With xlApp.ActiveSheet

.Cells(2, 1) = "N°"

.Cells(2, 2) = "Layer"

.Cells(2, 3) = "color"

.Cells(2, 4) = "Handle"

.Cells(2, 5) = "ObjectName"

.Cells(2, 6) = "x0"

.Cells(2, 7) = "y0"

.Cells(2, 8) = "z0"

.Cells(2, 9) = "Length/Volume"

.Cells(2, 10) = "Area/Rayon"

PNum = 3

On Error Resume Next

For Each oObj In ThisDrawing.ModelSpace

sLay = oObj.Layer

Set oLay = ThisDrawing.Layers(sLay)

If (Not oLay.Freeze) And (Not oLay.Lock) Then

.Cells(PNum, 1) = PNum

.Cells(PNum, 2) = oObj.Layer

.Cells(PNum, 3) = oObj.color

.Cells(PNum, 4) = "_" & oObj.Handle

.Cells(PNum, 5) = oObj.ObjectName

If oObj.ObjectName = "AcDbPolyline" Then

.Cells(PNum, 6) = oObj.Coordinate(0)(0)

.Cells(PNum, 7) = oObj.Coordinate(0)(1)

.Cells(PNum, 8) = oObj.Coordinate(0)(2)

.Cells(PNum, 9) = oObj.Length

.Cells(PNum, 10) = oObj.Area

End If

If oObj.ObjectName = "AcDbLine" Then

pBase = oObj.StartPoint

.Cells(PNum, 6) = pBase(0)

.Cells(PNum, 7) = pBase(1)

.Cells(PNum, 8) = pBase(2)

.Cells(PNum, 9) = oObj.Length

.Cells(PNum, 10) = ""

End If

If oObj.ObjectName = "AcDbCircle" Then

pBase = oObj.Center

.Cells(PNum, 6) = pBase(0)

.Cells(PNum, 7) = pBase(1)

.Cells(PNum, 8) = pBase(2)

.Cells(PNum, 9) = oObj.Circumference

.Cells(PNum, 10) = oObj.Radius

End If

If oObj.ObjectName = "AcDbArc" Then

pBase = oObj.Center

.Cells(PNum, 6) = pBase(0)

.Cells(PNum, 7) = pBase(1)

.Cells(PNum, 8) = pBase(2)

.Cells(PNum, 9) = oObj.ArcLength

.Cells(PNum, 10) = oObj.Radius

End If

If oObj.ObjectName = "AcDb3dSolid" Then

pBase = oObj.Position

.Cells(PNum, 6) = pBase(0)

.Cells(PNum, 7) = pBase(1)

.Cells(PNum, 8) = pBase(2)

.Cells(PNum, 9) = oObj.Volume

.Cells(PNum, 10) = oObj.Area

End If

If oObj.ObjectName = "AcDbRegion" Then

Set oTmp = oObj

pBase = oObj.Position

.Cells(PNum, 6) = "" 'pBase(0)

.Cells(PNum, 7) = "" 'pBase(1)

.Cells(PNum, 8) = "" 'pBase(2)

.Cells(PNum, 9) = oObj.Perimeter

.Cells(PNum, 10) = oObj.Area

End If

If oObj.ObjectName = "AcDbBlockReference" Then

pBase = oObj.InsertionPoint

.Cells(PNum, 6) = pBase(0)

.Cells(PNum, 7) = pBase(1)

.Cells(PNum, 8) = pBase(2)

.Cells(PNum, 9) = oObj.EffectiveName

.Cells(PNum, 10) = ""

End If

PNum = PNum + 1

End If

Next oObj

End With

Exit Sub

fin:

MsgBox "Un fichier excel doit être ouvert", vbExclamation

End Sub

 

ça a fait exactement ce que je voulais

[latino3131]

Bonjour

 

petit déterrage de post!!!! pardon pour la poussière

 

Je suis dans le même cas que CED mais le lien du message précèdent ne fonctionne plus

 

Help

 

Merci

[latino3131]

Jai bien réussi a faire la manip de mr lecrabe

 

mais je souhaite quantifier dans un tableau les volumes de plusieurs solide 3d pour un debit des bois d'une maison

 

merci

[bonuscad]

Bonjour,

 

Je rebondis sur cette discussion pour automatiser cette astuce (forcer le volume ou l'aire) sur des "3DSOLID" et créer facilement les champs.

Voici le code lisp qui permet cela...

 

(vl-load-com)
(defun c:SolidVolume-Area2Field ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw n dxf_cod lremov k_mod ename ll ur nw_obj)
 (princ "\nSélectionnez un solide.")
 (while
   (null
     (setq js
       (ssget "_+.:E:S"
         (list
           '(0 . "3DSOLID")
           (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
           (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
         )
       )
     )
   )
   (princ "\nCe n'est pas un objet solide valable pour cette fonction!")
 )
 (initget 6)
 (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: ")))
 (if htx (setvar "TEXTSIZE" htx))
 (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0))
 (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" "Id-Volumes"))
     (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Volumes") 'color 96)
   )
 )
 (cond
   ((null (tblsearch "STYLE" "Romand-Field"))
     (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field"))
     (mapcar
       '(lambda (pr val)
         (vlax-put nw_style pr val)
       )
       (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
       (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
     )
   )
 )
 (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz")))
   (progn
     (initget "KM ME CM MM")
     (if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] <ME>: ")))
       (setq unit_key "ME")
     )
     (cond
       ((eq unit_key "KM")
         (setq unit_draw 1000000)
       )
       ((eq unit_key "ME")
         (setq unit_draw 1000 unit_key "M")
       )
       ((eq unit_key "CM")
         (setq unit_draw 10)
       )
       ((eq unit_key "MM")
         (setq unit_draw 1)
       )
     )
     (setvar "USERS5" (strcat "qz" (itoa unit_draw)))
   )
   (progn
     (setq unit_draw (atoi (substr (getvar "USERS5") 3)))
     (cond
       ((eq unit_draw 1000000)
         (setq unit_key "KM")
       )
       ((eq unit_draw 1000)
         (setq unit_key "M")
       )
       ((eq unit_draw 10)
         (setq unit_key "CM")
       )
       ((eq unit_draw 1)
         (setq unit_key "MM")
       )
     )
   )
 )
 (initget "Unique Multiple _Single Multiple")
 (if (eq (getkword "\nSélection filtrée [unique/Multiple]<M>: ") "Single")
   (setq n -1)
   (setq
     dxf_cod (entget (ssname js 0))
     js
     (ssget "_X" 
       (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov))))
         (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
       )
     )
     n -1
   )
 )
 (initget "Volume Surface _Volume Area")
 (setq k_mod (getkword "\nMesurer [Volume/Surface] <Volume> : "))
 (if (not k_mod) (setq k_mod "Volume"))
 (repeat (sslength js)
   (setq
     obj (ssname js (setq n (1+ n)))
     ename (vlax-ename->vla-object obj)
   )
   (vla-GetBoundingBox ename 'll 'ur)
   (setq
     ll (safearray-value ll)
     ur (safearray-value ur)
     pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5))
     nw_obj
     (vla-addMtext Space
       (vlax-3d-point pt)
       0.0
       (strcat
         "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
         (itoa (vla-get-ObjectID ename))
         ">%)."
         k_mod
         " \\f \"%lu2%pr2%ps["
         (if (eq k_mod "Volume") "V=," "S=,")
         (strcase unit_key T)
         (if (eq k_mod "Volume") "\\\U+00B3]\">%" "²]\">%")
       )
     )
   )
   (mapcar
     '(lambda (pr val)
       (vlax-put nw_obj pr val)
     )
     (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
     (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Field" "Id-Volumes" rtx)
   )
 )
 (prin1)
)

[lecrabe]

Hello Bruno

 

Jolie routine qui ecrit en texte le volume ou la surface des 3DSOLID AutoCAD !!

 

MERCI, Bon WE, Bye, lecrabe

[-Ced-]

Bonjour,

Je re déterre mon ancien sujet, car j'aimerais savoir si quelqu'un peu modifié la VBA précédemment donnée (je ne connais pas le VBA) pour ajouter une colonne "Zone de contour: Limite inférieure" Z ou "Zone de contour: Limite superieure" Z que l'on obtient avec la commande "liste".

(La colonne Z0 de la VBA ne n'est pas renseignée chez moi)

 

Merci