AutoCAD et VBA

21 mars 2014

Lier une ligne de repère à un nom de bloc

Cette macro permet de noter le nom d'un bloc sélectionné à l'aide d'une ligne de repère. En adaptant le code on pourrait extraire la valeur d'un attribut ou extraire la longueur d'une spline ou une aire quelconque.

'Cette macro permet de noter dans une ligne de repère le nom du bloc sélectionné
Sub NoterNomBloc()
Dim Pt As Variant, Pp As Variant, Pp1 As Variant
Dim Entite As AcadEntity
Dim NomBloc As String
Dim Points(0 To 5As Double
Dim Echelle As Double
Dim F1 As Integer, F2 As Integer
Dim i As Long
Dim Calque As String, NomStyle As String
Dim oML As AcadMLeader

On Error GoTo Err_NoterNomBloc

'Initialisation des variables :
Echelle = 1 'Echelle de la "Leaderline" (A régler en fonction de l'échelle du dessin)
Calque = "0" 'Nom du calque où sera inséré le repère (Attention ! il faut qu'il soit présent dans le dessin !)
NomStyle = "Standard" 'Nom du style de la leaderline

'Fonctionnement de la macro en boucle
'Taper  pour quitter
    Do
    'Sélection du bloc :
        Do
            ThisDrawing.Utility.GetEntity Entite, Pt, "Sélectionner le bloc"
            If Entite.ObjectName = "AcDbBlockReference" Then Exit Do
            MsgBox "L'objet cliqué n'est pas un bloc !", vbExclamation, "Erreur de sélection !"
        Loop

    'Extraire le nom du bloc :
        NomBloc = Entite.Name

    'Insérer une ligne repère
        'Sélection des points d'insertion :
        Pp = ThisDrawing.Utility.GetPoint(, "Saisir emplacement")
        Pp1 = ThisDrawing.Utility.GetPoint(Pp, "Saisir position")
        'La position de la leaderline n'est pas très évoluée, je la repositionne plus finement après.
        If Pp(0> Pp1(0Then
            F1 = -1
        Else
            F1 = 1
        End If
        If Pp(1> Pp1(1Then
            F2 = -1
        Else
            F2 = 1
        End If
        Points(0= Pp(0):  Points(1= Pp(1):  Points(2= 0
        Points(3= Pp(0+ 50 * F1:  Points(4= Pp(1+ 50 * F2:  Points(5= 0
        'Insertion du repère dans le dessin :
        Set oML = ThisDrawing.ModelSpace.AddMLeader(Points, i)
        'Ajout du nom du bloc "En dur" dans le repère :
        oML.TextString = NomBloc
        'On place le repère dans le bon calque
        oML.Layer = Calque
        'avec le bon style
        oML.StyleName = NomStyle
        'et à la bonne échelle
        oML.ScaleFactor = Echelle
    Loop

'Gestion des erreurs
Err_NoterNomBloc:
    If Err.Number <> -2147352567 Then
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure NoterNomBloc."
    End If
End Sub
Coloration syntaxique vb/vba/vb.net

Posté par OtO_CAD à 22:45 - Commentaires [0] - Permalien [#]


29 septembre 2013

Longueur des courbes en VBA

J'ai répondu à ce message sur les forum Autodesk et je reproduis ma réponse in french cette fois ci, histoire de faire vivre un peu mon blog qui n'a pas eu de nouveau sujet depuis plus d'un an...

La question orginale était : comment trouver la longueur d'une polyligne en vba ?

original

La réponse est assez simple, il faut sélectionner une entité dans le dessin puis trouver la propriété Longueur (Length) de cette entité. Auparavant, il faut tester l'entité pour vérifier s'il s'agit bien d'une polyligne car si on clique sur un arc de cercle par exemple, la longueur de l'arc se retrouve par sa propriété LongueurArc (ArcLength) et dans ce cas, la macro renverra une erreur.
Quitte à tester l'entité sélectionnée, autant rendre polyvalente la macro et renvoyer la longueur de l'entité sélectionnée, quelque soit le type de l'entité, pourvu qu'elle ait une longueur en unité mesurable (ce qui n'est pas le cas d'un texte par exemple, qui peut avoir une longueur en nombre de lettre, mais ce n'est pas le propos ici).

Le reste de la macro gère les erreurs imprévues ou lorsque on clique dans le vide ou qu'on presse la touche "Echappement" pour arrêter la macro lors de la sélection de l'entité.

Code :


Option Explicit

Sub LongueurCourbes()
Dim oEntite As AcadEntity
Dim P1 As Variant
Dim strMessage As String

'Gestion des erreurs :
On Error GoTo Err_LongueurCourbes

    'Sélection de l'entité à mesurer
    ThisDrawing.Utility.GetEntity oEntite, P1, vbCrLf & "Selectionner une ligne, un arc, un cercle ou une polyligne (2D or 3D)"

    'En fonction du type de l'entité (ObjectName)
    Select Case oEntite.ObjectName
        Case "AcDbCircle"
            'On indique le type d'objet (un cercle) puis son périmètre dans la variable strMessage
            strMessage = "Cercle : " & oEntite.Circumference

        Case "AcDbArc"
            'On indique le type d'objet (un arc) puis sa longueur dans la variable strMessage
            strMessage = "Arc : " & oEntite.ArcLength

        Case "AcDbLine"
            'On indique le type d'objet (une ligne) puis sa longueur dans la variable strMessage
            strMessage = "Ligne : " & oEntite.Length

        Case "AcDbPolyline"
            'On indique le type d'objet (une polyligne 2D) puis sa longueur dans la variable strMessage
            strMessage = "Polyligne : " & oEntite.Length

        Case "AcDb3dPolyline"
            'On indique le type d'objet (une polyligne 3D) puis sa longueur dans la variable strMessage
            strMessage = "Polyligne 3D : " & oEntite.Length

        Case Else
            'Autre cas si l'entité sélectionnée n'est pas ce qu'on attend
            strMessage = "Erreur ! L'entité sélectionnée n'est pas une ligne, un arc, un cercle ou une polyligne."
    End Select


'Sortie de la macro
Exit_LongueurCourbes:
    'On écrit sur la ligne de commande le message concocté plus haut, ou, si une serreur s'est produite, le message d'erreur
    ThisDrawing.Utility.Prompt strMessage
    'On libère la mémoire de l'objet entité
    Set oEntite = Nothing
    'Puis on quitte la macro
    Exit Sub

'Gestion des erreurs
Err_LongueurCourbes:
    'L'erreur -2147352567 correspond à l'erreur si la touche Echappement est pressée ou si rien n'a été sélectionné
    'Dans ce cas, on ne renvoie pas le message d'erreur, on sort simplement de la macro.
    If Err.Number <> -2147352567 Then
        strMessage = "Erreur : " & Err.Description
    End If
    GoTo Exit_LongueurCourbes
End Sub


Merci à Coloration syntaxique vb/vba/vb.net pour la mise en forme de ce code.

Comme toujours, n'hésitez pas à commenter ce code :)

Posté par OtO_CAD à 10:56 - Commentaires [0] - Permalien [#]

05 mai 2012

Installer, sauvegarder, utiliser et charger une macro vba

Un commentaire sur ce blog me demande comment on fait pour charger et exécuter une macro vba dans AutoCAD.

Voilà la procédure. A noter que depuis les récentes versions d'AutoCAD, il faut d'abord télécharger sur le site Autodesk le add-on vba qui n'est plus livré de série avec la version complète de ACAD.

 

A) Pour installer une macro vba, il faut :

  1. Ouvrir AutoCAD et laisser un dessin ouvert (même un nouveau dessin vide)
  2. Aller dans le Menu Outils > Macro vba > Editeur Visual Basic (ou faire ALT+F11)
    • L'éditeur de macros vba s'ouvre


B) Dans cet éditeur :

  1. Afficher la fenêtre "Projet - ACADProject" si elle ne l'est pas (normalement elle est affichée par défaut) :
  2. Menu Affichage > Explorateur de projets (CTRL+R)
  3. Dans cette fenêtre, faire un clic droit sur la ligne ACADProject (Global1)
  4. Sélectionner dans le menu déroulant Insertion > Module
    • Un nouveau module s'ouvre


C) Dans ce module :

  1. Copier sur le blog l'ensemble du code compris entre les deux lignes horizontales et le coller dans le module


D) Sauvegarder la macro

  1. Dans l'éditeur vba, menu Fichier > Enregistrer Global1
  2. Sélectionner un endroit où sauvegarder la macro
  3. Fermer l'éditeur


E) Utiliser la macro :

  1. Dans AutoCAD, menu Outils > Macro VBA > Macros... (ALT+F8)
  2. Sélectionner la ligne Global1!Module1.CdG et faire Exécuter
  3. Sélectionner une région... (ou ECHAP pour arrêter).

F) Réutiliser cette macro dans une autre session :

  1. Dans l'explorateur Windows, aller dans le répertoire où vous avez stockez le projet (c'est un fichier portant l'extension .dvb)
  2. Faire glisser ce fichier dans la fenêtre AutoCAD
  3. Ensuite, faire comme au point E

Posté par OtO_CAD à 12:07 - - Commentaires [2] - Permalien [#]
Tags : , ,

Créer un tableau de coordonnées pour un spline ou polyligne

Lors de mes programmations, je suis souvent amené à créer des polylignes. Or après avoir calculé les coordonnées de chaque points composant la polyligne, il est fastidieux de devoir compléter le tableau des coordonnées de la polyligne.

Rappel de l'aide AutoCAD pour dessiner une polyligne :


Dim plineObj As AcadLWPolyline
Dim points(0 To 9) As Double

' Définition des points composant la polyligne :
points(0) = 1: points(1) = 1
points(2) = 1: points(3) = 2
points(4) = 2: points(5) = 2
points(6) = 3: points(7) = 2
points(8) = 4: points(9) = 4

' Dessin de la polyligne dans l'espace objet
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)


On voit dans l'exemple ci dessus qu'il peut devenir rapidement fastidieux de définir les points de la polyligne ! D'autant plus que les ponts sont souvent calculés séparément avant, ce qui peut donner du code de ce type :


points(0) = P1(0): points(1) = P1(1)
points(2) = P2(0): points(3) = P2(1)
points(4) = P3(0): points(5) = P3(1)
points(6) = P4(0): points(7) = P4(1)
points(8) = P5(0): points(9) = P5(1)


Pour 5 points ça devient lourd. Pour une polyligne comportant beaucoup plus de points, ce n'est même pas la peine ! C'est pourquoi j'ai écrit cette petite fonction AjtPt qui permet d'ajouter les coordonnées d'un point donné en paramètre à un tableau de coordonnées donné également en paramètre.

Pour le code précédent, ça donnerait quelque chose comme cela :


Tbl = AjtPt(P1, Tbl )
Tbl = AjtPt(P2, Tbl )
Tbl = AjtPt(P3, Tbl )
Tbl = AjtPt(P4, Tbl )
Tbl = AjtPt(P5, Tbl )


Plus simple à coder, non ? :)
Autre avantage, plus besoin de connaitre la taille de la polyligne au début, la taille du tableau est réglée dynamiquement en fonction du nombre de points.

 

Pour finir, un exemple concret. Dans le code suivant, la procédure principale TracerUnePolyligneDeQuatrePoints on clique 4 fois dans l'espace objet et une polyligne passant par les 4 points cliqués est tracée.


Sub TracerUnePolyligneDeQuatrePoints ()
Dim P1 As Variant
Dim tabCoordonnees
Dim i As Integer

'Saisie de 4 points
    For i = 1 To 4
        P1 = ThisDrawing.Utility.GetPoint(, "Cliquer un point")
        tabCoordonnees = AjtPt(P1, tabCoordonnees)
    Next i

'Trace la polyligne dans l'espace objet avec le tableau de coordonnées
'renseigné avec la fonction AjtPt
    ThisDrawing.ModelSpace.AddLightWeightPolyline tabCoordonnees
End Sub

'Cette fonction ajoute les coordonnées (x,y) du point P1 donné
'en paramètre au tableau tabCoord donné en paramètre
'Elle renvoie un tableau de nombres type "Double" pouvant servir
'de de tableau de coordonnées pour une polyligne
'-------------------------------------------------------------------
'V.1 05/05/2012 - AutoCAD et VBA - http://autocadvba.canalblog.com/
'-------------------------------------------------------------------
Private Function AjtPt(P1 As Variant, tabCoord) As Variant
Dim tableau() As Double
Dim NbVal As Integer
    If IsEmpty(tabCoord) Then
        ReDim tableau(0 To 1)
        tableau(0= P1(0)
        tableau(1= P1(1)
    Else
        tableau = tabCoord
        NbVal = UBound(tableau)
        ReDim Preserve tableau(0 To NbVal + 2)
        tableau(NbVal + 1= P1(0)
        tableau(NbVal + 2= P1(1)
    End If
    AjtPt = tableau
End Function


A vos commentaires ! :)

 

Posté par OtO_CAD à 11:45 - - Commentaires [1] - Permalien [#]
Tags : , , ,

15 septembre 2011

Faire la liste des calques dans l'espace objet

Aujourd'hui, je vous propose un petit code "clé en main" qui fait la liste des calques et la place dans l'espace objet. Chaque ligne de texte définissant le nom de calque, ainsi que ses propriétés type de ligne, épaisseur de trait et couleur est placé dans son calque respectif.

Il peut être ainsi facile d'imprimer cette liste de calque par exemple.

Comme tous les autres codes de ce site, il a été testé sous ACAD2005 et Windows XP. A copier dans un module.


'-------------------------------------------------------------------
'Cette macro liste les calques présents dans le dessin en écrivant
'leur nom, type de trait, épaisseur de trait et couleur dans
'l'espace objet. Chaque ligne sera rangée sur son calque respectif
'Auparavant, la macro demandera de saisir l'emplacement de la liste
'à l'écran.
'-------------------------------------------------------------------
'V.1 14/09/2011 - AutoCAD et VBA - http://autocadvba.canalblog.com/
'-------------------------------------------------------------------

Sub ListerCalques()
'Liste des variables
Dim Calque As AcadLayer
Dim objTxt As AcadText
Dim interligne As Double
Dim htTexte As Double
Dim NomCalque As String
Dim TypeLigne As String
Dim EpLigne As String
Dim Couleur As String
Dim Texte As String
Dim PtIns As Variant

On Error GoTo ListerCalques_Error

'Initialisation de la macro
    'Trouve la hauteur de texte du style courant
    htTexte = ThisDrawing.ActiveTextStyle.Height
    'Si la hauteur=0, alors choisir la hauteur 2
    If htTexte = 0 Then htTexte = 2.5
    'Valeur de l'interligne
    interligne = 1.5
    'Demande de l'emplacement de la liste
    PtIns = ThisDrawing.Utility.GetPoint(, "Saisir l'emplacement de la liste")

'Parcours de la liste des calques présents dans le dessin
    For Each Calque In ThisDrawing.Layers
        With Calque
            'Détermination du nom du calque
            NomCalque = .Name
            'Détermination du nom de type de ligne
            TypeLigne = .Linetype
            'Détermination de l'épaisseur de la ligne
            If .Lineweight = -3 Then '-3 est le code pour les lignes Ep Par défaut
                EpLigne = "Par défaut"
            Else 'Sinon, le code de l'épaisseur est donné en 100e
                'Il faut le convertir pour trouver des millimètres
                'et le formater pour obtenir 2 chiffres après la virgule
                EpLigne = Format(CStr(.Lineweight / 100), "0.00")
            End If
            Select Case .color 'Détermination de la couleur
                'ACAD possède 6 variables définissant les couleurs de base
                'On traduit les variables en français.
                Case acWhite:  Couleur = "Blanc"
                Case acYellow:  Couleur = "Jaune"
                Case acGreen:  Couleur = "Vert"
                Case acRed:  Couleur = "Rouge"
                Case acCyan:  Couleur = "Cyan"
                Case acBlue:  Couleur = "Bleu"
                Case acMagenta:  Couleur = "Magenta"
                'Les autres couleurs, on indique leur numéro
                Case Else:  Couleur = "N°" & CStr(.color)
            End Select

            'Comosition de la ligne. Chaque paramètre est séparé par --
            Texte = NomCalque & " -- " & TypeLigne & " -- " & EpLigne & " -- " & Couleur
            'Insertion du texte dans l'espace objet
            Set objTxt = ThisDrawing.ModelSpace.AddText(Texte, PtIns, htTexte)

            objTxt.Layer = .Name 'On place le texte créé dans son calque
            objTxt.color = acByLayer 'On règle la couleur le texte sur Par calque
            objTxt.Linetype = "BYLAYER" 'On règle le type de trait du texte sur Par calque
            objTxt.Lineweight = acLnWtByLayer 'On règle l'épaisseur du texte sur Par calque

            'On modifie la valeur y du point d'insertion en la soustrayant de
            'la hauteur du texte courant x interligne choisie.
            PtIns(1= PtIns(1- htTexte * interligne
        End With
    Next 'Traitement du calque suivant

'Fin de la macro
On Error GoTo 0
Exit Sub

'Gestionnaire d'erreur :
ListerCalques_Error:
    If Err.Number = -2147352567 Or Err.Number = -2145320928 Then
        'Si la touche échap ou le clic droit de la liste est pressé
        'quand le point d'insertion est demandé, on quitte la macro.
        Exit Sub
    Else 'Sinon, donner un message d'erreur.
        MsgBox "Une erreur s'est produite", , "Liste des calques"
    End If
End Sub


 Coloration syntaxique vb/vba/vb.net

 

Posté par OtO_CAD à 00:33 - - Commentaires [1] - Permalien [#]
Tags : , ,


27 août 2011

Piloter AutoCAD avec Excel

J'ai reçu un message de Cédric qui me demande un exemple de pilotage d'AutoCAD à partir de Excel :

J'ai l'idée de créér un programme afin de dessiner des éléments paramétriques dans autocad.
Voilà comment ça fonctionne, je prend l'exemple d'un rectangle :
Les paramètres sont décrits dans Excel. Pour un rectangle, je rentre a et b dans Excel (largeur et longueur). Toujours dans excel, ces paramètres sont traduits en 4 lignes dont les cellules contiennent les infos suivantes :
ligne point1x point1y point2x point2y, couleur, epaisseur type de trait
puis j'execute une procedure qui lit ces 4 lignes et trace les lignes dans AutoCAD.
Ma question : comment donner des instructions dans le programme autocad depuis un programme excel?

Voici une solution qui correspond à cette demande. J'ai utilisé au maximum les fonctions d'Excel pour limiter les objets à utiliser avec AutoCAD. Par exemple, je pilote les codes des couleurs et d'épaisseurs des traits directement dans le tableur, ainsi la procédure n'a plus qu'à les lire pour les utiliser directement dans la routine (on aurait pu faire la traduction directement dans la procédure en vba).

La première chose à faire est de programmer la feuille Excel pour obtenir les valeurs qui seront lues et traitées par la procédure sous Excel.

On commence par indiquer les données d'entrée :

  • Longueur du rectangle
  • Hauteur du rectangle
  • Point d'insertion du rectangle
  • Couleur et épaisseur des traits

Pour les valeurs de la longueur, hauteur et les coordonnées du point d'insertion (x et y), pas de difficulté particulière.

Pour la définition de la couleur et de l'épaisseur, j'ai choisi d'utiliser des listes déroulantes donnant les valeurs en clair (Rouge, Vert, Du calque etc.) qu'il faut ensuite traduire en code couleur ou code épaisseur pour qu'AutoCAD puisse les interpréter directement dans le programme.

Codes couleur :

On défini la couleur d'une entité d'AutoCAD par cette fonction :

Entité.Couleur = Numéro d'une couleur

  • Entité étant un objet d'AutoCAD (ligne, cercle, arc, texte etc.)
  • Couleur étant la propriété de l'objet.
  • Numéro d'une couleur étant un nombre de type Integer (un entier) ou directement une variable prédéfinie dans AutoCAD, du type acXxx

Notes : ce nombre est défini par une variable AutoCAD. Par exemple la couleur rouge (code couleur 1) est définie par la variable AcRed.
On peut trouver la liste de ces variables dans l'aide AutoCAD : Menu ? > Aide aux développeurs > Onglet Index > Color property (CAO)

Certaines couleurs sont particulières : Par exemple, la couleur DuCalque est définie par le code 256 ou par la variable acByLayer

Exemple : Pour mettre une ligne en rouge on peut indifféremment faire :

 

  • Ligne.Color = AcRed

ou

  • Ligne.Color = 1

 

La "traduction" de la couleur indiquée en clair (par exemple Rouge) en code interprétable par AutoCAD se fait directement dans Excel en utilisant la fonction RECHERCHE(Valeur recherchée;Matrice) (voir Tableau 1 du fichier Excel ci-dessous).
Note : Il y a deux listes de couleurs dans ce tableau : Une est ordonnée pour l'affichage de la liste déroulante, une seconde est ordonnée pour la fonction RECHERCHE qui exige que les valeurs recherchées soient triées dans l'ordre alphabétique pour trouver la bonne valeur correspondante.

La valeur sélectionnée dans la cellule D15 est ainsi traduite dans la cellule I38. C'est dans cette dernière cellule que le programme ira lire la valeur de la couleur à tracer dans AutoCAD.

Codes pour les épaisseurs de lignes :

On défini l'épaisseur d'une entité d'AutoCAD par cette fonction :

Entité.Epaisseur = Numéro d'une épaisseur

  • Entité étant un objet d'AutoCAD (ligne, cercle, arc, texte etc.)
  • Epaisseur étant la propriété de l'objet.
  • Numéro d'une épaisseur étant un nombre de type Integer (un entier) ou directement une variable prédéfinie dans AutoCAD, du type acLnWtXXX

C'est le même principe que pour les couleurs, à chaque épaisseur de trait correspond une variable AutoCAD du type acLnWtXXX qui peut aussi être indiquée directement par un nombre entier.

Exemple : Pour mettre une ligne en épaisseur 0,13 mm on peut indifféremment faire :

  • Ligne.Lineweight = acLnWt013

ou

  • Ligne.Lineweight = 013

Les types de traits spéciaux (DuBloc, DuCalque, Défaut) ont des valeurs numériques négatives :
Exemple : DuBloc -> acLnWtByBlock -> -2
(Voir Tableau 2 du fichier Excel ci-dessous).

Les autres épaisseurs des traits sont numériquement définies par leur épaisseurs réelles multipliées par 100
Exemple : Largeur 0,13 mm -> acLnWt013 -> 13

Le code du programme :

Ces différentes variables définies dans Excel, on peut maintenant écrire la procédure qui va successivement :

  1. Déclarer l'objet AutoCAD dans Excel (ne pas oublier de référencer AutoCAD dans Excel en allant dans le menu Outils > Références de l'éditeur vba).
  2. Créé l'objet AutoCAD
  3. Déclarer les différentes variables objet utilisées par AutoCAD : Objet Document AutoCAD et objet Ligne.
  4. Déclarer les différentes variables numériques utilisées par AutoCAD : les points (du type tableau à 3 "cases" de type numérique Double, les codes couleur et épaisseurs.
  5. Calculer et définir les valeurs nécessaires aux programme.
  6. Tracer le rectangle
  7. Fermer les objets pour les libérer de la mémoire de l'ordinateur.

Note : On aurait pu rajouter un gestionnaire d'erreur, mais ceci reste un exemple que je ne veux pas compliquer.

Ce qui donne comme code :


Sub Rectangle()
'Nécessite la référence Autocad xxx Type Library (Menu Outils > Références)
Dim AcadApp As AcadApplication, AcadPlan As AcadDocument

'Création de l'objet AutoCAD dans Excel :
Set AcadApp = AcadApplication
'Si ACAD n'est pas ouvert, il faut créer une nouvelle application comme si dessous :
'Set AcadApp = New AcadApplication

'Rend AutoCAD visible
AcadApp.Visible = True

'Ci dessous, ouvre un document précis :
'Set AcadPlan = AcadApp.Documents.Open("D:\Temp\test.dwg")
'ou sinon, utilise le document ouvert :
Set AcadPlan = AcadApp.ActiveDocument

'Définition des variables des points composant le rectangle :
Dim Pori(0 To 2As Double 'Point origine
Dim P1(0 To 2As Double
Dim P2(0 To 2As Double
Dim P3(0 To 2As Double
'Définition des variables définissant la couleur et l'épaisseur du trait
Dim Couleur As AcColor
Dim Epaisseur As AcLineWeight
'Définition de l'objet ligne
Dim Ligne As AcadLine

'Définition des coordonnées des points du rectangle lues dans Excel
Pori(0= Cells(104):  Pori(1= Cells(105'Point d'origine avec z=0 par défaut (pori(2)=0)
P1(0= Cells(114):  P1(1= Cells(115)
P2(0= Cells(124):  P2(1= Cells(125)
P3(0= Cells(134):  P3(1= Cells(135)

'Définition de la valeur de la couleur
Couleur = Cells(389'Lecture du code de la couleur choisie dans Excel

'Définition de l'épaisseur du trait
Epaisseur = Cells(399'Lecture du code de l'épaisseur choisie dans Excel

'Traçage du rectangle dans l'espace objet d'AutoCAD
Set Ligne = AcadPlan.ModelSpace.AddLine(Pori, P1) 'Traçage de la 1ere ligne
Ligne.Color = Couleur 'Donne la couleur choisie
Ligne.Lineweight = Epaisseur 'Donne l'épaisseur choisie
'2e ligne
Set Ligne = AcadPlan.ModelSpace.AddLine(P1, P2)
Ligne.Color = Couleur
Ligne.Lineweight = Epaisseur
'3e ligne
Set Ligne = AcadPlan.ModelSpace.AddLine(P2, P3)
Ligne.Color = Couleur
Ligne.Lineweight = Epaisseur
'4e ligne
Set Ligne = AcadPlan.ModelSpace.AddLine(P3, Pori)
Ligne.Color = Couleur
Ligne.Lineweight = Epaisseur

'Rafraichir l'affichage de la fenêtre active
AcadPlan.Regen acActiveViewport

'Libérer la mémoire des objets ouverts
Set Ligne = Nothing
Set AcadApp = Nothing
Set AcadPlan = Nothing

'AcadPlan.Save 'Sauvegarde le dessin
'AcadPlan.Close 'Ferme le dessin
'AcadApp.Quit 'Ferme l'application AutoCAD

End Sub


et le fichier Excel correspondant : télécharger ici (il va falloir me faire confiance en acceptant de charger les macros lorsque vous aurez le message de sécurité donné par Excel quand il va détecter la présence de code dans le classeur ! Il n'y a pas de code malicieux !)

Posté par OtO_CAD à 13:12 - - Commentaires [16] - Permalien [#]
Tags : , ,

19 avril 2011

Retrouver les objets sélectionnés à l'écran après avoir lancé une macro vba

Je viens de recevoir ce message d'un lecteur de ce blog :

Le but de mon mail est de vous poser une question juste pour avoir une piste de recherche (car je stagne depuis 3 jours ...)
Je cherche a faire une macro dans laquelle je travaillerai sur l'objet actif (sélectionné)
J'ai bien trouvé le bout de code pour selectionner un nouvel objet, mais ce n'est hélas pas ce que je cherche.

Effectivement, c'est pas très marrant, après avoir lancer une macro vba, de devoir resélectionner les objets patiemment sélectionnés avant et qu'on a perdu à cause de la commande lancée.

Il faut utiliser l'option acSelectionSetPrevious pour retrouver les objets sélectionnés auparavant.

L'exemple ci-dessous renvoie le nom de chaque objets AutoCAD sélectionnés avant de lancer une macro vba :


Sub ErreurJeuSelection()
'Déclaration des variables :
Dim sset As AcadSelectionSet 'variable du type "jeu de sélection AutoCAD"
Dim entite As AcadEntity

On Error GoTo gestErr 'Si VBA rencontre une erreur en cours d'exécution, aller au gestionnaire d'erreur

'Creation du jeu de sélection "JeuSel1"
'Si le jeu de sélection "JeuSel1" existe déjà, il y aura une erreur:
'VBA ira sur le gestionnaire d'erreur avant de revenir à la ligne suivante

Set sset = ThisDrawing.SelectionSets.Add("JeuSel")

sset.Select acSelectionSetPrevious 'Voir aussi avec : acSelectionSetLast

For Each entite In sset
    MsgBox entite.ObjectName
Next

'Avant de quitter la procédure, on efface l'objet "sset"
Set sset = Nothing
'puis on efface le jeu de sélection de la mémoire :
ThisDrawing.SelectionSets.Item("JeuSel").Delete

'Fin de l'exécution ici :
Exit Sub 'On quitte la procédure

gestErr: 'Ici commence le gestionnaire d'erreurs

If Err.Number = -2145320851 Then 'Si le code d'erreur correspond à celui d'un jeu de sélection déjà existant
    ThisDrawing.SelectionSets.Item("JeuSel").Delete 'Alors on efface le jeu de sélection de la mémoire
    Set sset = ThisDrawing.SelectionSets.Add("JeuSel") 'Puis on recrée un nouveau jeu de sélection
    Resume Next 'Et on repart à la ligne qui suit celle qui a engendré l'erreur
Else 'Sinon
    MsgBox Err.Number & " : " & Err.Description 'indiquer le code d'erreur et sa description
    Exit Sub 'puis quitter la procédure
End If

End Sub



Posté par OtO_CAD à 23:54 - - Commentaires [0] - Permalien [#]
Tags :

16 avril 2011

Test

Confronté depuis quelques jours à des problèmes de spam venant de Chine, je vais tenter de rendre subversif ce blog, afin qu'il soit bloqué par la Grande Muraille de Feu de Chine et qu'il soit invisible aux spammeurs chinois.

Donc, je continue de parler d'AutoCAD et des macros vba ici, mais auparavant, permettez moi de vous rappeller certains sujets importants sur les droits de l'homme en Chine :

Les manifestations de Tian'anmen, largement désignées dans une grande partie du monde par le terme « massacre de la place Tian'anmen », se déroulent entre le 15 avril 1989 et le 4 juin 1989 sur la place Tian'anmen à Pékin, la capitale de la République populaire de Chine.

Elles prennent la forme d’un mouvement d'étudiants, d'intellectuels et d'ouvriers chinois, qui dénoncent la corruption et demandent des réformes politiques et démocratiques. La contestation s'étend à la plupart des grandes villes, comme Shanghai, et aboutit à Pékin à une série de grandes manifestations et de grèves de la faim organisées sur la place Tian'anmen. Après plusieurs tentatives de négociation, le gouvernement chinois instaure la loi martiale le 20 mai 1989 et fait intervenir l'armée le 4 juin 1989.

La répression du mouvement provoque un grand nombre de victimes civiles (de quelques centaines à quelques milliers selon les sources), et de nombreuses arrestations dans les mois qui suivent. Plusieurs dirigeants politiques favorables au mouvement sont limogés et placés en résidence surveillée, notamment le secrétaire général du Parti communiste chinois, Zhao Ziyang. Par la suite, un coup d'arrêt durable est porté aux réformes politiques en République populaire de Chine. Le gouvernement expulse les journalistes étrangers et contrôle strictement la couverture de l’évènement par la presse chinoise. À l'étranger, la répression provoque une condamnation générale du gouvernement chinois.

The Tiananmen Square protests of 1989, also known as the Tiananmen Square massacre and the June Fourth Incident(in part to avoid confusion with two prior Tiananmen Square protests), were a series of demonstrations in and near Tiananmen Square in Beijing in the People's Republic of China (PRC) beginning on 15 April 1989. The movement used mainly non-violent methods and can be considered a case of civil resistance.Led mainly by students and intellectuals, the protests occurred in the year that was to see the collapse of a number of communist governments in eastern Europe.

The protests were sparked by mass mourning over the death of former CPC General Secretary Hu Yaobang, a Party official who had been purged for his support to political liberalization.By the eve of Hu's funeral, 100,000 people gathered at Tiananmen Square.The demonstrations were begun by Beijing students to encourage continued economic reform and liberalization,and evolved into a mass movement for political reform.From Tiananmen Square they later expanded to the surrounding streets. Non-violent protests also occurred in cities throughout China, including Shanghai and Wuhan. Looting and rioting in various locations throughout China, including Xi'an and Changsha.

tiananmen_square_tank1_1808_1_

Autre revendication importante : Le Tibet Libre !

Tibet, mars 2008 : les rues de la capitale tibétaine sont en flammes. Des manifestations rappellent à l'opinion internationale que le problème tibétain n'est pas résolu. Depuis 50 ans, le Dalaï-lama, chef spirituel du Tibet, vit en exil, mais il incarne toujours les espoirs de son peuple. Pourtant, la stagnation de la situation provoque de plus en plus de mécontentements y compris dans les rangs de ses plus fervents fidèles. Le film explore aussi ses doubles responsabilités en tant que pratiquant bouddhiste et leader politique, les dilemmes et les contradictions que génèrent ces deux rôles. Est-ce que la solution pour le Tibet se trouve dans le chemin de paix et de compromis du Dalaï-lama ? Ou bien est-ce que les voix appelant à l'indépendance vont l'emporter ?

Free Tibet

10 facts about Tibet

 


1. The invasion of Tibet began in 1949. Chinese occupation has resulted in the death of over one million Tibetans, the destruction of over 6,000 monasteries, nunneries and temples, and the imprisonment and torture of thousands of Tibetans.

2. The Dalai Lama*, Tibet's political and spiritual leader, fled Tibet in 1959 to Dharamsala, India, followed by over 100,000 Tibetans and established the Tibetan Government-in Exile. In 1989, he was awarded the Nobel Peace Prize for a steadfast dedication to non-violence.

3. Tibet, before occupation, was a nation with an established sovereign government, currency, postal system, language, legal system, and culture. Prior to 1950, the Tibetan government also signed treaties with foreign nations. The Chinese government claims that Tibet has always been part of China, yet its invasion of Tibet resembles imperialist aggression that China accuses other powers of exhibiting.

4. The "Tibetan Autonomous Region" (TAR) is not Tibet, nor is it autonomous. The Chinese government has divided historical Tibet into one region and several prefectures and counties, with the TAR encompassing only the central area and some eastern regions of Tibet.

5. The basic freedoms of speech, religion, and assembly are strictly limited, and arbitrary arrests continue. There are currently hundreds of political prisoners in Tibet, enduring a commonplace punishment of torture.

6. The Chinese government increasingly encourages Han Chinese to migrate to Tibet, offering them higher wages and other inducements. This policy is threatening the survival of Tibetan people. Tibetans are becoming a minority in the TAR. Yearly, thousands of Tibetans still flee from Tibet, making the treacherous journey over the Himalayas into a world of exile.

7. Historical Tibet was a vast country, with an area roughly equal to Western Europe. Tibet is the source of five of Asia's largest rivers, which provide water for two billion people. Tibet's fragile environment is endangered by Chinese strip-mining, nuclear waste dumping, and extensive deforestation.

8. The Chinese government claims to have “developed” Tibet, with “developments” mainly benefiting the new majority Chinese, not Tibetans. China, neglecting education and healthcare, has spent millions of dollars building infrastructure; many roads, buildings, and power plants directly support heavy militarization, allowing China to maintain Tibet as a police state.

9. The Chinese government aggressively seeks foreign investment for its “Go West” campaign, with use of these international funds to develop Tibet as a resource extraction colony and consolidate regional control. Foreign investments in Chinese companies legitimise China's colonisation and exploitative projects that harm Tibet.

10. The United Nations and international community have done very little to address the core issue of China’s illegal occupation of Tibet. China represents an enormous market and cheap labour force, and its associated businesses have such a strong lobby that officials are reluctant to take substantive measures. Since western countries adopted policies of so-called “constructive engagement” with China in the 1990s, the human rights situation in Tibet has only deteriorated.

Edit : du 26/08/2011 : depuis que j'ai posté ce message, plus aucun spam venant de Chine :) Cette astuce fonctionne donc ! Trop fort ! Comment utiliser la censure chinoise à son propre profit...

Posté par OtO_CAD à 09:03 - Commentaires [0] - Permalien [#]
Tags : ,

09 mars 2011

Offre de services

Je peux réaliser pour vous vos personnalisations sous AutoCAD, à l'aide de macros en Visual Basic ou Visual Basic pour Application.

Je développe aussi des applications pour Excel, Access et notamment en ce qui concerne la gestion électronique des documents.

Ainsi, j'ai développé une base Access qui gère le suivi des modifications des documents CAO, avec liaisons entre AutoCAD, et les outils Microsoft Office : Access, Outlook, Excel et Words :

  • Suivi des indices et des évolutions.
  • Suivi des diffusions des documents techniques : à qui et quand ? avec automatisation des envois par mail.
  • Consultation des documents techniques par les agents de maîtrise de l'atelier
  • Système d'abonnement et d'avertissement quand un document évolu.
  • Suivi des remarques des clients et des sociétés de contrôle.
  • Archivage des documents sur CD/DVD/Serveur en cours ou fin d'affaire, avec listing des derniers documents à jours dans un classeur Excel.
  • Annuaire d'entreprise et d'affaires.

Autres réalisations sur AutoCAD :

  • Sortie automatique de dessins AutOCAD au format Acrobat PDF (avec enregistrement dans la base GED) et sauvegarde suivant le classement des fichiers en vigueur dans l'entreprise.
  • Sortie semi automatique de pièces tôles pour leur imbrication, avec calcul de poids et de surfaces en fonction de leurs épaisseurs.
  • Escaliers paramétrés en 3D.
  • Travaux sur les blocs : recopier un bloc en tant que nouveau bloc, remplacer un bloc par un autre.
  • Dessins de pièces standards paramétrées en 2D : profilés, goussets, pièces mécaniques.

Je suis très attaché à l'ergonomie des interfaces de mes applications, car je suis convaincu qu'un programme bien ficelé encourage à son utilisation par l'utisateur et fait au bout du compte, une économie non négligeable de manipulations et d'argent.
L'automatisation d'opérations récurrentes peut vous faire gagner beaucoup de temps !

Contactez moi pour définir vos besoins. Ensemble, nous trouverons une solution pour vous faire gagner en productivité !

 

Posté par OtO_CAD à 19:12 - - Commentaires [0] - Permalien [#]
Tags : , , , , , , , , , ,

15 avril 2010

Statistiques

Ce blog a été ouvert le 15 mars 2008 et un an plus tard, il y a eu 2493 pages vues et plus de 1300 visiteurs uniques.

  • Stats 2008-2009 :

Stats_2008_2009

L'an passé, la fréquentation est en hausse, puisqu'il y a eu 3871 pages vues et plus de 2500 visiteurs uniques se sont connectés sur AutoCAD et VBA !

  • Stats 2009-2010 :

Stats_2009_2010

Merci pour vos visites, ça me fait plaisir de voir du passage régulier sur ce blog.

Je regrette néanmoins le peu de commentaires, 5 en deux ans, ça fait très peu ! Je sais que lorsqu'on est bloqué sur un problème quand on est sur du code, on ne veut pas perdre son temps à lacher un com' suivant la formule consacrées sur les skyblog ! mais si vous avez des idées pour améliorer les codes proposés, c'est très facile ! Il n'y a même pas besoin de s'incrire pour le faire ! Il suffit de cliquer sur Commentaires, en bas du message ;)

Posté par OtO_CAD à 23:00 - Commentaires [0] - Permalien [#]