Comme le titre l'indique, je tente d'approcher le VBA, avec un premier succès...mitigé !

La routine que j'ai rédigée doit simplement rendre courant le layer "0", activer tous les layers, dégeler tous les layers et es geler tous sauf certains.

Aucun message d'erreur, mais pas moyen de rendre les layers actifs.

Quelqu'un voit-il pourquoi ?

Sub Layers()

'Rend courant le layer "0":
Set objLayer = ThisDrawing.Layers("0")
objLayer.LayerOn = True
ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")

'Dégeler tous les layers du dessin:
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" Then Layer.Freeze = False
Next

'Activer tous les layers du dessin:
For Each Layer In ThisDrawing.Layers
LayerOn = True
Next Layer

'Geler tous les layers sauf certains :
For Each Layer In ThisDrawing.Layers
If Layer.Name <> "0" And Layer.Name <> "AR_TXT_M2" And Layer.Name <> "AR_TXT_NOMS" And Layer.Name <> "CARTOUCHE" And Layer.Name <> "CLOISONS" And Layer.Name <> "FD" And Layer.Name <> "FD_FENETRES" And Layer.Name <> "FD_HACHURES" And Layer.Name <> "FD_MOBILIER" And Layer.Name <> "FD_PORTES" And Layer.Name <> "FD_SANITAIRES" And Layer.Name <> "FN" And Layer.Name <> "FN$" And Layer.Name <> "TXT" Then
If Layer.Name <> "0" Then Layer.Freeze = True
End If
Next

ThisDrawing.Regen acActiveViewport

End Sub

un archi original à trouve une fonction inconue pour moi des hachures, il y met un arrière plan blanc que je trouve moche car il me planque les réseaux qui se retrouvent parfois dessous.

Comme il y en a dans des bloc une sélection de toutes les hachures pour virer cet arrière plan dans les propriété est pas facile

je voudrai donc faire un petit lisp pour les virer j'ai 2 petit lisp pour sortir les propriété DXF ou un dump VBA de l'objet sélectionné

Que ce soit dans le (entget ou le (vlax-dump-object, je ne trouve pas trace de ce remplissage

QQs sait ou je peux trouver ça?

merci

J'ai un fichier dans lequel plusieurs blocs sont définis. Comment pourrais je faire pour exporter automatiquement tous ce blocs afin d'avoir au final un fichier par bloc (manuellement je le fais en insérant dans le fichier chaque bloc, puis en utilisant la commande Wblock).

Merci par avance de votre aide.

Je souhaite mettre à jour tous les bloc de mon dessin par les blocs portants le même nom contenus dans un autre fichier dwg.

J'ai tenté le LISP sans succès, les blocs s'insèrent sans se redéfinir et j'essai donc le Vba dont je n'ai aucune notion.

Pour choisir mon fichier source des bloc je souhaite utiliser Application.getopenfilename ("Fichier DWG (*dwg), *dwg") mais visiblement autocad ne reconnais pas la commande.

Si vous avez une solution à m'apporter pour réaliser cette tache, se serait d'une grande aide.

Merci

Nouveau sur le forum, je sollicite votre aide pour un sujet de copie de données d'Excel vers un formulaire Inventor.
J'ai créé un formulaire qui s'affiche directement à l'ouverture d'une nouvelle pièce via un évènement déclencheur et une règle pour remplir les ipropriétés d'une pièce (nom, numéro, indice, etc). 
Je cherche à pré-remplir en automatique les champs de ce formulaire par un fichier Excel qui nous fait l'incrémentation des numéros de pièces (par exemple en "scannant" la ligne sélectionnée pour les différents champs nécessaires).
Est-ce possible, et si oui, pourriez-vous m'aider à mettre cela en place?
Pour vous situer, côté compétences, j'ai fait le fichier Excel de génération/incrémentation de pièces et d'indices, donc je connais la programmation vba Excel, mais ne sais pas comment faire le lien avec un autre logiciel comme Inventor.

Je ne connais pas du tout le VBA mais il me faudrait compléter une macro

Je voudrais dire :

si la valeur de Tilemode est égale à 1, c'est ok

si la valeur de tilemode est égale à 0, il faut la passer à 1

Je vous remercie.

Merci pour votre aide !

Préambule : Dans le cadre d'une demande au sein de mon travail, je me creuse la tête pour trouver un équilibre entre rapidité et participé de mise à jour.

Situation : J'ai un fichier excel utilisé en BDD dont chaque ligne est un bâtiment de notre patrimoine. A chaque bâtiment on fait une "fiche", produite sous AUTOCAD, comprenant texte, hachure et plans.

Problème : Malheureusement pour un soucis de communication, la hiérarchie souhaite que ces fiches soient sur un PPT et modifiable

Action actuelle :

0/Création "fiche batiment" sur autocad

1/ On pioche dans excel, on renseigne dans autocad

2/ on recupère les plans  -1 batiment = 1 fichier/étage- mis en bloc vers fichier fiche => Amélioration possible passer par du XREF

3/ on colorise les espaces pour mettre en avant les informations d'usages des espaces

4/Export PDF

5/Export depuis PDF vers PPT par Acrobat DC puis on pioche à la main pour remettre les element du PPT vers le PPT final...

Réflexion : je fais des schémas pour reflechir à comment me faciliter la vie mais je ne trouve pas de solutions ultimes ou partielles.

Pour l'instant, je reflechis à du VBA qui transfère les infos texte depuis EXCEL vers PPT puis pour les plans, je ne vois que le faire à la main...

Question : Auriez-vous des idées pour m'aider à avancer sur ce problème ?

Merci, bonne journée,

J'ai créé une petite macro dans mon fichier DWG qui me permet d'ouvrir Onenote pour y indiquer toutes les modifications que j'apporte à mon plan.

Mais est-il possible que cette macro s’exécute directement que j'ouvre mon fichier.

Merci d'avance pour votre aide.

Bonne journée

(setenv "TCModule" "Variable à Bibi")
(princ (getenv "TCModule"))

Mais depuis le VBA, je n'arrive pas à y accéder, par contre, je n'ai aucun problème avec les variables système.
La variable système ne me pose aucun problème :

VarCad = ThisDrawing.GetVariable("FILLMODE")
MsgBox VarCad     'Pas de problème

Mais pas ma variable perso :

VarCad = ThisDrawing.GetVariable("TCModule")

J'ai une erreur en retour : "Erreur en accédant à une variable système".

J'ai raté un truc ? Les variables "perso" ne sont pas considérées comme "système" ?

Suite à une demande par MP pour extraire toutes les images d'un classeur vers un dossier, je me disais qu'il serait bon de partager ce code :

1°) définir le dossier

2°) Boucler sur les formes des feuilles

3°) vérifier les types de formes pour ne traiter QUE les images

4°) Copier l'image l'inserer dans un objet pour les graphiques (coller l'image) et export l'objet graphique

Sub export_img()
Dim dossier As String
Dim monimage As String
dossier = ThisWorkbook.Path & "\"
For i_NF = 1 To Sheets.Count
    Worksheets(i_NF).Activate
    NB_IMG = Worksheets(i_NF).Shapes.Count
    For i_IMG = 1 To NB_IMG
        Worksheets(i_NF).Shapes.Item(i_IMG).Select
        Set sh = Worksheets(i_NF).Shapes.Item(i_IMG)
        If sh.Type <> 13 Then GoTo suivant:
        Call sh.CopyPicture(xlScreen, xlBitmap)
        nomimage = dossier & Worksheets(i_NF).Name & "-" & i_IMG & ".jpg"
        With Worksheets(i_NF).ChartObjects.Add(0, 0, sh.Width, sh.Height).Chart
            .Paste
            .Export nomimage, "JPG"
        End With
suivant:
    Next i_IMG
Next i_NF
End Sub

Edit :

Si vous souhaitez mettre les images dans des dossiers avec le nom des onglets d'ou elles proviennent :

Sub export_img()

'Parcours de toutes les feuilles
For i_NF = 1 To Sheets.Count
Worksheets(i_NF).Activate
NB_IMG = Worksheets(i_NF).Shapes.Count

    'Parcours de toutes les images
    For i_IMG = 1 To NB_IMG
    
    Worksheets(i_NF).Shapes.Item(i_IMG).Select
    
    'détection si images
    If Worksheets(i_NF).Shapes.Item(i_IMG).Type <> 13 Then GoTo suivant:
        
    Call Worksheets(i_NF).Shapes.Item(i_IMG).CopyPicture(xlScreen, xlBitmap)
    
    Set Sh = ActiveSheet.Shapes(i_IMG)
    
    dossier = ThisWorkbook.Path & "\" & Worksheets(i_NF).Name & "\"
    
    On Error Resume Next
    MkDir dossier
    On Error GoTo 0
    
    monimage = dossier & Worksheets(i_NF).Name & "-" & i_IMG & ".jpg"
    
    With ActiveSheet.ChartObjects.Add(0, 0, Sh.Width, Sh.Height).Chart
        .Paste
        'Sauvegarde l'image du graphique au format jpg
        .export monimage, "JPG"
    End With

suivant:
    Next i_IMG
Next i_NF

End Sub

Je suis à la recherche d'une commande ou d'un lisp sur AutoCAD me permettant de détecter des conflits / superpositions de ligne.

L'idéal serai de détecter ce conflit sur des calques et/ou objet distinct ou même si possible entre un claque/objet avec un Xréf.

Par exemple avec l'image ci-dessous de détecter sur tout le dessin quand le cercle en pointillé vert touche le rectangle noir.

Cette Commande ou Lisp est-t-il possible ?

Merci d'avance

J'ai trouver ce GIF sur internet, c'est exactement ce que je souhaite faire si cela peut aider à la compréhension de ma demande ^^

J’aurais besoin de vos lumières🤔.
J’ai le code VBA ci-dessous qui détecte les polylignes non fermées dans un dessin AutoCAD.
Le problème c’est qu’il le fait sur toutes les polylignes se trouvent dans tous les calques.

J’aimerais faire cette détection seulement dans un seul calque, le calque « Polygonale »

Est-possible ?

Merci d'avance

Sub PolylignesOuvertes()
 For Each ent In ThisDrawing.ModelSpace
  ent.color = acWhite
  If ent.ObjectName = "AcDbPolyline" Then
   If ent.Closed = False Then
    ent.color = acRed
   Else
    ent.color = acGreen
   End If
  End If
 Next ent
ThisDrawing.Regen (acActiveViewport)
End Sub

Il y a quelques temps, ce forum m'avait sauvé la vie avec ce code, pour créer un filtre de calques.

Public Sub CreaFiltre(NomFiltre As String)
    'Création de filtres **********************************************
    Dim Dict1 As Object
    Dim Dict2 As Object
    Dim DaRec As Object
    Dim DaType(0 To 6) As Integer
    Dim DaValue(0 To 6) As Variant
    If NomFiltre <> "" Then
        DaType(0) = 1: DaValue(0) = NomFiltre
        DaType(1) = 1: DaValue(1) = NomFiltre & "*"
        DaType(2) = 1: DaValue(2) = "*"
        DaType(3) = 1: DaValue(3) = "*"
        DaType(4) = 70: DaValue(4) = 0
        DaType(5) = 1: DaValue(5) = "*"
        DaType(6) = 1: DaValue(6) = "*"

        Set Dict1 = ThisDrawing.Layers.GetExtensionDictionary
        Set Dict2 = Dict1.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary")
        Set DaRec = Dict2.AddXRecord(NomFiltre)
        DaRec.SetXRecordData DaType, DaValue
    End If
End Sub

Et il fonctionne à merveille ! ! !

Mais maintenant, je me retrouve avec trop de filtres, j'aimerais donc créer des "sous-filtres". Et des "sous-sous-filtres"

Comme :
Denis1
   -Denis2
         -Denis3

Avec un Sub comme ceci, je pense :

Public Sub CreaFiltre(NomFiltre As String, NomFiltreParent As String)
	...
	...
End Sub

Par exemple, le filtre "Denis2" serait un "sous-filtre" de "Denis1", un peu comme l'arborescence des répertoires...

J'ai cherché "ACAD_LAYERFILTERS", mais là Google n'était pas mon ami...

Si quelqu'un a une astuce, un conseil... Je suis preneur...

Bien à toi la communauté...

Denis...

Voila 6 mois je travail sans relâche sur mon projet en VBA et compagnie...

et depuis mi décembre la taille est fixé à 3114 Ko. j'ai rajouté des modules, des Userforms des lignes dans mes modules

Je sais qu'un module (".bas") ne dois pas dépasser 64kb j'en est 60 et 20 ".frm".

Mais hormis cette limitation est ce qu'il y en a d'autres ? et sauriez vous pourquoi la taille du .dvb ne change pas ?

ThisDrawing.SendCommand "(vlax-ldata-put """"DenisH"""" """"Test"""" 0)"

Mais AutoCAD tourne en boucle, et lorsque je l'arrête, il me répond : 

Citation

Commande: (vlax-ldata-put ""DenisH"" ""Test"" 0)'VLIDE ; erreur: nombre d'arguments trop important

Auriez-vous une astuce, un conseil ? ? ?
Bien à toi, la communauté, et une excellente année ! ! !
Denis...

J'utilise ce code pour choisir un bloc :

Dim objENT As AcadEntity
Dim objBlk As AcadBlock
Dim objBlkRef As AcadBlockReference

Dim pt1 As Variant
Dim attribs As Variant

On Error Resume Next
ThisDrawing.Utility.GetEntity objENT, basepnt, "pick block : "
         attribs = objBlk.objENT.GetAttributes

Mais comment faire pour attribuer directement un nom de bloc sans devoir le choisir.

Exemple la selection se fait directement sur le bloc qui s'appelle  "BlocTest" qui se trouve dans l'espace papier.

Merci

Est-il possible via VBA de copier les valeurs des attributs d'un bloc vers un autre bloc.

Merci

J'ai commencé un bout de code, mon premier listbox (LB_Onglet_Source) m'affiche tous les onglets de mon dessin quand je sélectionne un onglet je doit afficher dans mon deuxième listbox (LB_Bloc_Source) la liste des blocs de cet onglet, mais mon problème est que tous les blocs de chaque onglet se retrouve de le deuxième listbox.

J'aimerais si je clique sur presentation1 je n'ai que les blocs de presentation1 et ainsi de suite.

Ci-joint mon code

Merci d'avance

Dim AcadApp As Object
Dim AcadDoc As Object

'   **********************************************************************************************************

Private Sub UserForm_Initialize()

    Dim AcadApp As Object
    Dim AcadDoc As Object
    Set AcadApp = GetObject(, "AutoCAD.Application")
    Set AcadDoc = AcadApp.ActiveDocument
    Dim onglet As AcadLayout
    
    On Error Resume Next
 
 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    Set AcadApp = GetObject(, "AutoCAD.Application")
    Set AcadDoc = AcadApp.ActiveDocument

    If AcadApp Is Nothing Then
    
    If MsgBox("AUTOCAD n'est pas ouvert" & vbLf & "Voulez-vous ouvrir AUTOCAD", 36, "Ouvrir AUTOCAD") = vbYes Then
   
      Set AcadApp = CreateObject("AutoCAD.Application")
       AcadApp.Visible = True
    End If
   End If



LB_Onglet_Source.Clear


For Each onglet In AcadDoc.Layouts
    'If onglet.Name <> "Model" Then
        LB_Onglet_Source.AddItem onglet.Name
    'End If
Next onglet


End Sub
'   **********************************************************************************************************

'   **********************************************************************************************************

Private Sub LB_Onglet_Source_Change()

Dim obj_onglets As AcadLayouts
Dim obj_onglet As AcadLayout
Dim index As Integer
Dim position As Integer
Dim totaux As Integer

For index = 0 To LB_Onglet_Source.ListCount - 1
If LB_Onglet_Source.Selected(index) = True Then
    position = index
    totaux = totaux + 1
End If


    
    Tb_Onglet_Source = LB_Onglet_Source.List(position)
   
    
    Dim nbrblocs As Integer 'nombre de calques dans le dessin courant
    Dim numbloc As Integer 'nième calque dans la liste
    nbrblocs = ThisDrawing.Blocks.Count
    For numbloc = 1 To nbrblocs
    Me.LB_Bloc_Source.AddItem ThisDrawing.Blocks(numbloc - 1).Name
    Next numbloc

    

Next index

Set obj_onglets = ThisDrawing.Layouts


End Sub

Public Sub ImpTypLignCAD()
    Dim AcadApp As Object
    Set AcadApp = GetObject(, "AutoCAD.Application")
    Dim DocAutoCad As Object
    Set DocAutoCad = AcadApp.ActiveDocument

    Dim entry As Object
    For Each entry In DocAutoCad.Linetypes
        MsgBox "Calq=" & entry.name
        Lign = Lign + 1
    Next
End Sub

Mais je n'obtiens que trois types de ligne : ByBlock, ByLayer et Continuous. Sachant qu'il y en a d'autres dans le dessin.
J'ai le même problème pour tous les autres dessins.

Si quelqu'un a une astuce, un conseil... Je suis preneur...

Bien à toi, la communauté.
Denis...

NB : on peut remplacer 2018 par une version ultérieure dans l'URL

Je suis en train de développer un classeur Excel (.XLSM) qui créé des calques directement dans AutoCAD.

Mon problème est en deux partie, causé par un futur partage. Sachant que tout le monde n'a pas la même version d'Excel que moi ni la même version d'AutoCAD que moi :
 - Comment, en VBA bien-sur, connaitre la et/ou les versions d'AutoCAD installées sur le poste ?
 - Comment charger le ou les "AutoCAD XXXX Type Library" correspondants aux AutoCAD lancées et/ou installés ?
(il faut aussi tenir compte aussi que, grâce à une lumineuse idée de @rebcao, je compte créer aussi une macro qui créera un fichier script (.SCR), donc, sans AutoCAD sur la machine)

Actuellement, je lance mon Excel 365 depuis mon poste et contrôle mon AutoCAD 2022, mais si je partage mon classeur avec un utilisateur d'AutoCAD 2019 (par exemple), mes macros ne fonctionnerons pas, car je ne charge que la librairie d'AutoCAD 2022 et non celle d'AutoCAD 2019.

Mon but étant de partager ce classeur (qui sera autant pour les versions "complètes" que les versions LT), comment charger le ou les "AutoCAD * Type Library" existantes dans le système ?

Si quelqu'un a une astuce, un conseil, un lien, une solution... Je suis preneur.

Bien à toi, la communauté.

Denis.