Aller au contenu

Topheur

Membres
  • Compteur de contenus

    93
  • Inscription

  • Dernière visite

Tout ce qui a été posté par Topheur

  1. Bonjour et bonne année au forum :) Pour cette nouvelle année, j'ai changé de boite. Mon ancienne boite travaillée avec Autocad :) et ma nouvelle sur ... Autocad LT :( Du coup, j'avais accumulé pas mal de lisp qui me permettais de gagner du temps. Le hic c'est que Autocad LT ne prend pas en charge les lisp !!! Ne désirant pas me tourner vers du piratage, ma question est peut on faire se que l'on faisait avec des lisp en Autocad LT via des macros (ou autre). J'ai par exemple deux lisp (pour commencer :) )qui me sauverais la mise (je peux fournir les lisp) : - le premier me permettais de tracer une polyligne et d'inscrire sa longueur sur le dernier point (évite de cliquer dessus et de lire la propriété longueur) - le deuxième me permettais de faire des cotations alignée avec un seul point d'origine identique. Je m'explique, je clique sur mon point 1 et je clique sur le point 2 pour avoir une première côte, ensuite je clique sur mon point 3 qui me donne la côte alignée du point 1 au point 3. Cela me permettais d'avoir tant que je ne sortais pas de mon lisp : cotation alignée du pt 1 au pt 2 du pt 1 au pt 3 du pt 1 au pt 4 etc. Voilà, j'espère qu'il existe une solution simple car je commençais à me familiariser avec le lisp alors apprendre encore un autre langage je ne suis pas contre mais si on peux éviter ... Merci à vous... Et encore tous mes voeux pour la nouvelle année qui commence.
  2. Bonsoir, D'abord au sujet du message de gile, je vais me pencher dessus quand j'aurais un peu de temps car cela m’intéresse. Quand à didier, sujet clos, on enterre la hache de guerre Par contre je ne suis pas chatouilleux au sujet des copier/coller de code, c'est juste que le monde change et qu'il faut parfois avancer professionnellement très vite sans prendre le temps de comprendre se que l'on fait réellement et je le regrette ! Du coup, j'ai appris à faire le "chinois" (comme on dit chez nous, ou le moine copiste), c'est pas la meilleure méthode mais c'est ça ou on passe une semaine à faire un truc faisable en 10 secondes avec un lisp (oui 10 secondes car les PC du taff...) En tous cas j'espère bien que tu continueras à répondre si d'aventure je me heurte à un problème sur mes lisp :P et je ne t'en voudrais pas de corriger mes fautes (mais je te préviens, je suis un vrai petit poucet :) )
  3. Bonsoir, Pour info, il est vrai que je suis une quiche en orthographe, en conjugaison et en grammaire (et je m'en excuse). Je le prends un petit peu mal :angry: car je trouve (parfois) les remarques un peu blessante(je parle dans la vie de tous les jours). Du coup, j'applique la philosophie suivante ;) : "Ne juge pas trop vite les gens car ces derniers ont très souvent un passé qui n'est pas le tiens !!!" Je ne vais pas vous raconter ma vie mais je remercie déjà le ciel de m'avoir amené jusqu'ici et me serais bien marré de voir certaines personnes à ma place aujourd'hui (et leur niveau en général)... Bref... Je déteste l'injustice et j'aimerais rendre à César se qui lui appartient. Le lisp n'est pas de moi, je l'ai TOTALEMENT pompé et j'ai simplement modifié le nom des variables qui n'avait pas de sens pour moi. Je sais c'est pas bien mais j'ai appris le VBA comme ça et à l'heure d'aujourd'hui, je dispose d'un niveau correcte (je ne suis pas une bête mais j'ai fais la domotique de ma maison avec ! toc ! :P ). Du coup, je ne m'amuse pas (car je n'y prête aucune attention) à corriger les fautes d'orthographe. Pour en revenir au problème, merci à vous, il est résolu. Concernant les variables : nnom nnom2, n pour variable, nom pour la désignation, et 1,2,3 si plusieurs. Cela aurait donné npiece npiece2 pour un nom de pièce par exemple. Je ne sais pas si c'est la bonne méthode mais c'est celle que j'applique. Déclarer les variables, je le faisais en VBA via Dim car cela me planté mes macro mais en lisp je n'arrive pas à m'y faire et je ne les déclares pas souvent vu que cela ne plante pas le lisp. Pour la commande alertE, idem, pompé sur un code... Ecrit avec un E à la fin donc... je mets un E à la fin. Voilà messieurs, ne prenais pas mal mon message car je trouve votre forum super et les gens qui y participe également car sans VOUS je jouerais encore avec mon c... <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' />
  4. Une autre question, pourquoi la commande : (command "calque" "E" "test" "") Arrête mon lisp. Si je tape par exemple (command "calque" "E" "test" "") (alerte"test") le lisp crée le calque, le rend courant (se que je désire) mais il ne m'affiche pas le message. Pourquoi ?
  5. Merci Gile. ;CREATION D'UN CALQUE EN FONCTION DU NOM TAPPER (defun c:NVCN() (setq nnom(getstring"\nNom du calque ? ")) (setq nnom2(getstring"\nNom du calque ? ")) (command "calque" "E" (strcat "00_" nnom nnom2 ) "") (princ) )
  6. Bonjour les lispeurs <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' /> Je reviens vers vous car je patauge (comme d'hab :P ). J'essaye de créer un calque avec 2 noms de variables sans succès. J'ai écris le code suivant : ;CREATION D'UN CALQUE EN FONCTION DE DEUX NOM TAPPER (defun c:NVCN() (setq nnom(getstring"\nNom ou numéro ? ")) (setq nnom2(getstring"\nNom ou numéro n°2 ? ")) (command "calque" "E" nnom & nnom2 "") (princ) ) Cela me crée un calque avec nnom mais pas avec nnom2. J'ai également essayé de supprimer le & et le remplacer par un espace mais cela ne fonctionne pas. En plus de cela, j'aimerais que le nom du calque devienne "00_nnom_nnom2" (ex. 00_VRD_01 ou 00_A1_ELEC) Voilà, merci de votre aide.
  7. Bonsoir et merci à TOUS :D Tous d'abord à Gile (mon idole :P et le premier à avoir répondu). J'aime ces réponses car elles me permettent de mieux comprendre le langage lisp. Pour La Lozère, je dois avouer que j'utilise AutoCad tous les jours mais je ne connaissais pas cette manip (le passage par les propriétés et les styles de cote). Mais j'ai besoin du point et pas uniquement de la valeur de la côte. Je dois dire que malheureusement, la société qui m'emploie (pourtant une très grosse entreprise) ne prends pas la peine de nous former (mes collègues et moi même) même après 12 ans de boite :( (mais ça c'est un autre débat). Du coup j'essaie d'apprendre et de m'améliorer par moi même et avec l'aide des experts AutoCad B) Pour Zebulon, j'avais essayé avec polar mais je n'y arrivais pas et concernant mon orthographe ... bah elle est archi mauvaise donc merci pour la correction du mot cote
  8. Bonsoir à tous, Voilà j'ai un problème simple (pour les pro du lisp <img src='http://cadxp.com/public/style_emoticons/<#EMO_DIR#>/laugh.gif' class='bbc_emoticon' alt=':(rires forts):' /> ) mais difficile pour moi. J'aimerais pouvoir tracer une côte (point début et point fin) mais que celle-ci n'affiche que la moitié de sa valeur. Pourquoi ? Je dois placer des éléments au milieu de pièce d'habitation (au milieu d'un couloir par exemple). Actuellement je trace ma côte (largeur du couloir ex. 1000), je sélectionne le point de fin pour le déplacer et je tape 1000/2, cela me fais ma côte à 500. Comme cela est trop long, j'ai voulu faire le lisp suivant : (defun c:topher (/ pdep pfin pmilieu) (setq pdep (getpoint "\nSpécifiez le premier point: ")) ;; point de départ de la côte (setq pfin (getpoint pdep "\nSpécifiez le deuxième point: ")) ;; point de fin de la côte (setq pmilieu (/(pfin 2))) (command "_dimlinear" pdep pmilieu) (princ) ) J'ai une erreur car j'essaye de diviser un point de coordonné (pfin) par 2. Je pense que la réponse est simple mais je ne trouve pas. Merci de votre aide.
  9. Bonjour Gile, Tous d'abord merci à toi, mon problème est résolu ! Pour ce qui est : "Il me semble qu'avant d'essayer d'intégrer une routine qui ne fait que sélectionner tous les objets sur un calque, il faut comprendre comment on traite un jeu de sélection." Je suis d'accord avec toi, le fait est que je n'ai AUCUNE base en lisp :( . Je comprends certains arguments à taper pour avoir certains résultats (création de calque ou mise en place de texte) mais c'est tous ! J’avoue ne pas y mettre beaucoup de bonne volonté :P ,je trouve ce langage très compliqué :wacko: . En plus on ne trouve pas énormément de lisps avec commentaires à chaque lignes, alors que j'ai "appris" le VBA en modifiant des bouts de codes (avec énormément de commentaires) et en utilisant l'enregistreur de macro (chose non disponible à ma connaissance sur Autocad). Je me demande même où vous avez appris ce langage ! En tous cas, forcé de constater que ce forum est très actif, réactif et qu'on y trouve bon nombre d'infos et de conseils quand on est bloqué. Encore merci à vous !
  10. Bonjour :) Grâce à Didier et un lisp trouvé sur le net, j'ai réussi à faire le code suivant qui me permet de tracer une ligne droite entre le point de départ et d'arrivée d'une polyligne, arc ou spline et de noter ça longueur au centre de la ligne : (defun c:Topher (/ pt1 pt2 dep ang obj pdep pfin) ;Création du calque si il n'existe pas pour séparer les infos (command "calque" "E" "@_Lg_Poly" "") ;Code pour la Mediatrice (vl-load-com) (setq obj (vlax-ename->vla-object (car (entsel "objet"))) pdep (vlax-curve-getstartpoint Obj) pfin (vlax-curve-getendpoint Obj) ) ;Code pour le calcul de la longueur ligne polyligne (vl-load-com) (setq obj (vlax-ename->vla-object (car (entsel "objet"))) pdep (vlax-curve-getstartpoint Obj) pfin (vlax-curve-getendpoint Obj) ) ;Trace une ligne virtuelle en rouge ;(grdraw pdep pfin 1) ;Trace la ligne physique (command "ligne" pdep pfin "") ;Calcul longueur ligne (setq LL (rtos (distance pdep pfin))) ;Cherche la médiatrice de la ligne pour placer la distance au milieu de la ligne (if (equal (caddr pdep) (caddr pfin) 1e-009) (progn (setq dep (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2))) pdep pfin) ang (+ (angle dep pdep) (/ pi 2)) ) (vl-cmdf "texte" "_non" dep (strcat "<" (angtos ang (getvar "AUNITS") 15)) 20 "" LL) ) (prompt "Les points ne sont pas dans un plan parallèle au plan du SCU courant." ) ) (princ) ) 0 Recherche J'imagine qu'il y a plus simple pour trouver le milieu de ma ligne et placer la valeur de la longueur mais bon se n'est pas mon soucis actuel. Maintenant j'aimerais pouvoir sélectionner plusieurs polyligne, arc ou spline en une fois et exécuter mon lisp automatiquement (pour éviter de relancer mon lisp sur mes polylignes, arc spline une par une). Pour info, toutes mes polylignes, arc spline sont sur le même calque, du coup j'ai trouvé le lisp de Gile qui selectionne tous : ;; Sélection par calque (defun c:ssl (/ ss ent) (and (or (and (setq ss (cadr (ssgetfirst))) (= 1 (sslength ss)) (setq ent (ssname ss 0)) ) (and (sssetfirst nil nil) (setq ent (car (entsel))) ) ) (sssetfirst nil (ssget "_X" (list (assoc 8 (entget ent))))) ) (princ) ) Mais je n'arrive pas à l'intégrer à mon code. Merci de votre aide :)
  11. Re-bonsoir Didier :P J'ai pris le temps de regarder et d'essayé de comprendre ton code. Je l'ai modifié pour incorporer des données supplémentaires (et apprendre la programmation en lisp). J'ai réussi à tracer une ligne physique et inscrire la valeur de la ligne au centre. Maintenant j'aimerais pouvoir sélectionner plusieurs polyligne et que mon lisp s'exécute automatiquement (pour éviter de cliquer sur mes polylignes une par une). Merci d'avance. PS : mon code actuel (defun c:Topher (/ pt1 pt2 dep ang obj pdep pfin) ;Création du calque si il n'existe pas pour séparer les infos (command "calque" "E" "@_Lg_Poly" "") ;Code pour la Mediatrice (vl-load-com) (setq obj (vlax-ename->vla-object (car (entsel "objet"))) pdep (vlax-curve-getstartpoint Obj) pfin (vlax-curve-getendpoint Obj) ) ;Code pour le calcul de la longueur ligne polyligne (vl-load-com) (setq obj (vlax-ename->vla-object (car (entsel "objet"))) pdep (vlax-curve-getstartpoint Obj) pfin (vlax-curve-getendpoint Obj) ) ;Trace une ligne virtuelle en rouge ;(grdraw pdep pfin 1) ;Trace la ligne physique (command "ligne" pdep pfin "") ;Calcul longueur ligne (setq LL (rtos (distance pdep pfin))) ;Cherche la médiatrice de la ligne pour placer la distance au milieu de la ligne (if (equal (caddr pdep) (caddr pfin) 1e-009) (progn (setq dep (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2))) pdep pfin) ang (+ (angle dep pdep) (/ pi 2)) ) (vl-cmdf "texte" "_non" dep (strcat "<" (angtos ang (getvar "AUNITS") 15)) 20 "" LL) ) (prompt "Les points ne sont pas dans un plan parallèle au plan du SCU courant." ) ) (princ) ) 0 Recherche
  12. Bonsoir Didier, Je vais dans un premier temps charger le fichier pour le tester et si il me conviens, je le regarderais plus en détail car j'avais d'autre chose à intégrer comme la gestion des calques et l'ajout d'attribut mais ça je bricole un peu et je veux essayer seul. En réalité, je préfèrerais faire mes lisp tous seul mais j'avoue ne pas avoir beaucoup de temps en ce moment pour apprendre ce langage. Je te tiens au courant pour mon retour d'expérience et en cas de problème pour modifier le lisp. Bonne soirée
  13. Bonjour à tous, Je viens vers vous car je me trouve face à un problème de rapidité :wacko: . En effet, j'ai des spline et des polyligne tracé sur un dessin. J'aimerais connaître la longueur la plus courte de cette dernière (spline OU polyligne). Je m'explique, la longueur en ligne droite entre le premier et le dernier point de la spline ou de la polyligne et non la longueur réelle de cette dernière. A l'heure d'aujourd'hui : - Je transforme mes splines en polyligne (via le clic droit) - Puis (toujours via le clic droit), je joint. - Ensuite j'utilise la commande _explode - Et je supprime les lignes qui composées la polyligne pour ne garder que la ligne droite (un boulo de Titan quoi). Du coup, je me disais qu'un petit lisp élaboré par les experts du forum me permettrais de gagner ENORMEMENT de temps ;) . Merci à tous ceux qui pourrons m'aider.
  14. Bonjour Bryce, Excuse moi de ne pas avoir répondu plus tôt mais je ne reçoit pas de notification de réponse. Je suis donc revenu sur mon post pour voir si il y avait eu une réponse. Je ne suis pas sur LT et j'aimerais avoir un lisp pour aller beaucoup plus vite. Je vais donc poster sur le bon forum. Merci de ta réponse.
  15. Bonjour à tous, Je viens vers vous car je me trouve face à un problème de rapidité :wacko: . En effet, j'ai des spline et des polyligne tracé sur un dessin. J'aimerais connaître la longueur la plus courte de cette dernière (spline OU polyligne). Je m'explique, la longueur en ligne droite entre le premier et le dernier point de la spline ou de la polyligne et non la longueur réelle de cette dernière. A l'heure d'aujourd'hui : - Je transforme mes splines en polyligne (via le clic droit) - Puis (toujours via le clic droit), je joint. - Ensuite j'utilise la commande _explode - Et je supprime les lignes qui composées la polyligne pour ne garder que la ligne droite (un boulo de Titan quoi). Du coup, je me disais qu'un petit lisp élaboré par les experts du forum me permettrais de gagner ENORMEMENT de temps ;) . Merci à tous ceux qui pourrons m'aider.
  16. Topheur

    Import/Export Excel Autocad

    Salut Guillaume ;) Tous d'abord, je tiens à te dire JE T'AIME !!! :(rires forts): Je savais que c'était dans ce bout de code et j'ai touché la réponse du bout du doigt ! J'ai chercher sur le net en vain et j'ai même essayé le nom de bloc mais sans la ligne FilterType(0) = 0 à 2 ça n'importer rien ! Pour répondre à ta question concernant ton message précédent j'avoue qu'attendant un heureux évènement :P , en ce moment je suis plus dans la réno de chambre et les forums de bricolage que sur le forum CAD, toutefois, j'avais regardé ton topic mais les liens de téléchargement sont morts :( . En tous cas, JE T'AIME, JE T'AIME, JE T'AIME ! Grâce à toi je vais gagner un temps fou sur mes nomenclatures. Un GRAND MERCI !
  17. Topheur

    Import/Export Excel Autocad

    Tous d'abord merci pour ces nombreuses réponse ;) Par contre j'avais omis un détail important (et qui répondra à lili2006), le code VBA est sur Excel et non Autocad. En fait, j'ouvre mon classeur excel, je clique sur importer et j'ai tous les blocs en import dans excel. Quand je clique sur export, cela envoi les modifs d'attributs dans autocad. (moi je voudrais choisir le bloc à importer) Mon tableur regroupant d'autres informations, l'idée est de dessiner sur autocad le jour 1, remplir mes paramètres dans excel le jour 2, faire mon import toujours sur excel et exporter ensuite. Comme ça je me sert UNIQUEMENT de mon tableur Excel et mon autocad et renseigné sans que je revienne dessus. Si je n'ai d'autre choix que d'utiliser autocad, je le ferais mais si quelqu'un arrivé à modif mon code VBA EXCEL pour la sélection de mon bloc se serais merveilleux :(rires forts): J'oubliais, je ne peux pas installer les express tools car je ne possède pas de CD d'installation car les PC de l'entreprise sont configurer au siège et que l'on a pas la main pour modifier quoi que se soit. En espérent que quelqu'un trouvera une astuce pour modifier ce code :D
  18. Bonjour à tous :) N'étant pas très doué en programmation mais sachant me servir de Goo... :P je cherche pour un projet autocad la possibilité d'importer/exporter vers excel les attributs de bloc autocad. J'ai trouvé un code qui fonctionne très bien MAIS je voudrais importer/exporter UN SEUL bloc que je choisirais au préalable. Pour info, mon autocad contient plusieurs folio avec des cartouches sous forme de bloc avec attribut et quand j'importe les attributs, j'ai les blocs de mes folios mais également celle de mes symboles et je me retrouve avec un tableau indigeste. L'idée et de pouvoir choisir mon bloc par un clic OU nommé le bloc dans le VBA Excel pour avoir un tableau excel avec les attributs de ce seul bloc. Ci dessous les codes de mes deux boutons VBA Excel (trouvé sur la toile) Dim DrawingFile As String Sub EnvoyerVersAutoCAD() Dim AcadApp As AutoCAD.AcadApplication Dim BlocRef As AcadBlockReference Dim Row, i, Column As Integer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If AcadApp.Visible = True ' Si le chemin du fichier n'est pas spécifié, on suppose qu'il est dans le même répertoire que le classeur Dim Filename As String If InStr(Cells(1, 1).Text, "\") <> 0 Then Filename = Cells(1, 1).Text Else Filename = ThisWorkbook.Path & "\" & Cells(1, 1).Text End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Filename, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Filename) End If Row = 4 ' On commence à la ligne N°4 Dim Handle As String While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide ' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la ' méthode HandleToObject de l'objet document AutoCAD Handle = Cells(Row, 2) Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle) ' Si le bloc a des attributs... If BlocRef.HasAttributes Then ' ... on les récupère Attributes = BlocRef.GetAttributes ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).TagString Then Attributes(i).TextString = Cells(Row, Column).Text End If Column = Column + 1 ' On passe à la colonne suivante Wend Next ' PROPDYN Attributes = BlocRef.GetDynamicBlockProperties On Error Resume Next ' On parcourt le tableau For i = LBound(Attributes) To UBound(Attributes) ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette ' de l'attribut Column = 3 While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(i).PropertyName Then Attributes(i).Value = Cells(Row, Column).Value End If Column = Column + 1 ' On passe à la colonne suivante Wend Next BlocRef.Update End If Row = Row + 1 ' On passe à la ligne suivante Wend Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "Les données ont été transférées vers AutoCAD avec succès." End Sub Public Sub ExtraireAttributs() Dim AcadApp As AutoCAD.AcadApplication Dim SelSet As AutoCAD.AcadSelectionSet Dim FilterType(0) As Integer Dim FilterData(0) As Variant Dim FiltersType, FiltersData As Variant Dim i, Row, j, Column As Integer Dim Entity As AcadEntity Dim BlocRef As AcadBlockReference Dim Attributes As Variant Dim ColumnExist As Boolean Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' Efface toutes les données contenues dans la feuille Range("1:65536").ClearContents ' On demande le nom du fichier à ouvrir Dim Filename As Variant Filename = Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg") If Filename = False Then Exit Sub End If Cells(1, 1).Value = Filename ' Connexion avec AutoCAD (on le lance si il n'est pas en cours d'exécution) On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") On Error GoTo 0 If AcadApp Is Nothing Then Set AcadApp = New AutoCAD.AcadApplication End If ' On ouvre le fichier DWG dans AutoCAD ou on l'active si il est déjà ouvert Dim Opened As Boolean Opened = False Dim Dwg As AcadDocument For Each Dwg In AcadApp.Documents If StrComp(Dwg.FullName, Cells(1, 1).Text, vbTextCompare) = 0 Then Dwg.Activate Opened = True End If Next If Not Opened Then AcadApp.Documents.Open (Cells(1, 1).Text) End If ' On remets Excel au premier plan (le lancement d'AutoCAD désactive la fenêtre Excel) Application.Visible = True ' Remplissage de l'entête du tableau Cells(3, 1).Value = "Nom du bloc" Cells(3, 2).Value = "Handle" Row = 4 ' 1ère ligne du tableau ' On crée un jeu de sélection ou on le récupère si il existe déjà On Error Resume Next Set SelSet = AcadApp.ActiveDocument.SelectionSets.Add("SELSET") If Err <> 0 Then Set SelSet = AcadApp.ActiveDocument.SelectionSets.Item("SELSET") SelSet.Clear End If ' On prépare un filtre de sélection sur les insertions de bloc FilterType(0) = 0 FilterData(0) = "INSERT" FiltersType = FilterType FiltersData = FilterData ' Sélection des entités SelSet.Select acSelectionSetAll, , , FiltersType, FiltersData ' On balaye le jeu de sélection For i = 0 To SelSet.Count - 1 Set Entity = SelSet.Item(i) ' Si l'objet est une insertion de bloc If Entity.ObjectName = "AcDbBlockReference" Then ' On précise le type de l'objet pour pouvoir accéder à ses propriétés et ' ses méthodes spécifiques Set BlocRef = Entity ' Si il a des attributs If BlocRef.HasAttributes Then Cells(Row, 1).Value = BlocRef.Name Cells(Row, 2).Value = "'" & BlocRef.Handle ' On les récupére Attributes = BlocRef.GetAttributes ' On parcourt le tableau For j = LBound(Attributes) To UBound(Attributes) ' On recherche si une colonne existe déjà pour cette étiquette d'attribut Column = 3 ColumnExist = False While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(j).TagString Then ' Une colonne existe, on la remplit avec la valeur de l'atribut Cells(Row, Column).Value = Attributes(j).TextString ColumnExist = True End If Column = Column + 1 ' On passe à la colonne suivante Wend If Not ColumnExist Then ' Aucune colonne n'existe, on en crée une et on la remplit Cells(3, Column).Value = Attributes(j).TagString Cells(Row, Column).Value = Attributes(j).TextString End If Next ' Attribut suivant ' PROP DYN Attributes = BlocRef.GetDynamicBlockProperties ' On parcourt le tableau For j = LBound(Attributes) To UBound(Attributes) ' On recherche si une colonne existe déjà pour cette étiquette d'attribut Column = 3 ColumnExist = False While Not IsEmpty(Cells(3, Column)) If Cells(3, Column).Text = Attributes(j).PropertyName Then ' Une colonne existe, on la remplit avec la valeur de l'atribut Cells(Row, Column).Value = Attributes(j).Value ColumnExist = True End If Column = Column + 1 ' On passe à la colonne suivante Wend If Not ColumnExist Then ' Aucune colonne n'existe, on en crée une et on la remplit Cells(3, Column).Value = Attributes(j).PropertyName Cells(Row, Column).Value = Attributes(j).Value End If Next ' Propriété dyn suivante Row = Row + 1 ' Ligne suivante End If End If Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès." End Sub En remercient par avance le génie qui pourra m'aider à avancer :P
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité