nazemrap

Bonjour, Le code étant dans un module Autocad, j' ai oublié de préciser dans mon exemple que les références aux objets ACCESS devaient être chargées bien sûr. Microsoft DAO 3.6 Object Library et Microsoft ACCESS 9.0 Object Library Egalement dans la base "bd1" créer la table "Table1" qui contient les champs. C'est un exemple; il n'est pas optimisé. Si plusieurs attributs sont à récupérer, il faut adapter, et faire attention aux doublons pour le champ "id_test".

Bonjour, Si j' ai bien compris, voici une approche. Après avoir créer une base (bd1) avec 2 champs : id_test (numéro_auto) surface (numérique) enregistrée sur C: Le code suivant demande à sélectionner un bloc avec attribut, à créer donc, (étiquette "surface") ayant reçu une valeur. Cette valeur est envoyée dans la base. Dim access As access.Application Dim mabase As Database Dim enreg As Recordset Dim atsurf As Long Dim obj As Object Dim attribut As Variant Dim bloc As AcadBlockReference Dim chemin As String Dim nbr As Integer Public Sub adb() ThisDrawing.Utility.GetEntity obj, "sélectionnez le bloc" If obj.ObjectName = "AcDbBlockReference" Then Set bloc = obj If bloc.HasAttributes Then attribut = bloc.GetAttributes Dim I As Integer For I = LBound(attribut) To UBound(attribut) If attribut(I).TagString = "SURFACE" Then valeur = attribut(I).TextString Next End If chemin = "C:/bd1.mdb" Set access = CreateObject("Access.Application") access.OpenCurrentDatabase chemin Set mabase = access.CurrentDb Set enreg = mabase.OpenRecordset("Table1", dbOpenTable) enreg.AddNew enreg("id_test") = 4 enreg("surface") = valeur enreg.Update access.CloseCurrentDatabase End Sub

Bonjour, également à 4 sans problèmes.

Bonjour, En fait, ce n'est pas une réponse, mais une question. Le fait d'obtenir une polyligne 3d est-il plus intéressant qu 'un spline. C' est en fait ce que j' utilise (la spline) pour récupérer en vba la ligne de chant supérieur des limons courbe balancées.. Cordialement

Bonjour, l' appréciation de la vitesse est toute relative ! Et la réflexion à mon avis indispensable. Une commande rectangle de 312*94 un cercle de rayon 16 en bas intérieur à droite, placé avec l' option accrochage "depuis" un cercle avec l' option [Ttr] tangent au petit cercle et à la droite supérieure, rayon du cercle 265. Ajuster les éléments en trop. Editer polyligne. J avais oublié la commande "contour"! Me trompe-je ?[Edité le 17/4/2007 par nazemrap] http://www.premiumwanadoo.com/technaulogis/cadxp/trace_01.jpg [Edité le 17/4/2007 par nazemrap] [Edité le 17/4/2007 par nazemrap]

Bonjour, menu outils > options onglet affichage zone elements de la présentation décocher l' option

Bonjour, je pense qu'il s'agit de la fonction [surligneur]ATN [/surligneur] atn(30/40)

Bonjour, Il doit falloir utiliser l'API windows. Voir ici [Edité le 25/1/2007 par nazemrap] [Edité le 25/1/2007 par nazemrap]

Bonjour, Vas voir le paramétrage de ton style de cote utilisé. Format>style de cote>unité principale>Echelle de mesure>facteur d' échelle .(à peu près) Il doit être à 0.5 remettre à 1

Bonjour, Je te met l'exemple d'Autocad; les points sont une liste de Double: Sub Example_AddLightWeightPolyline() ' This example creates a lightweight polyline in model space. Dim plineObj As AcadLWPolyline [surligneur]Dim points(0 To 9) As Double [/surligneur] ' Define the 2D polyline points 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 ' Create a lightweight Polyline object in model space Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) ZoomAll End Sub

Bonjour, Sous réserve, essaies avec cela: If objBlock.Item(i).ObjectName = "AcDbRotatedDimension"

Bonjour, Si j'ai bien compris, il te faut récupérer les coordonnées du point et le nom du calque ? En sélectionnant l'objet ligne (getentity) avec l'accrochage extrémité actif et en cliquant sur l'extrémité désirée ça doit marcher. Public Sub recp_calq_et_extremité() Dim ligne As AcadLine Dim ptselec As Variant Dim calq As String Dim ptdep(0 To 2) As Double 'Sélectionner avec l'option extrémité active ThisDrawing.Utility.GetEntity ligne, ptselec, "Cliquez avec accrochage l'extrémité de la ligne voulue" ptdep(0) = ptselec(0): ptdep(1) = ptselec(1): ptdep(2) = ptselec(2) calq = ligne.Layer MsgBox calq MsgBox ptdep(0) & "---" & ptdep(1) & "---" & ptdep(2) End Sub

Bonsoir, Le style de cote "standard" me semble correspondre à un format anglo-saxon, il serait peut-être mieux d' utiliser "ISO-25" et ajuster pour 1/500 suivant l'unité d'écran en Espace Objet Cordialement.

http://www.premiumwanadoo.com/technaulogis/zzenvers.jpg

Bonjour, Peut-être une piste.. Option Explicit Dim PTA As Variant 'Dim PTB As Variant Dim PTB(0 To 1) As Double Dim Obj_Decal As AcadLWPolyline Dim points(0 To 15) As Double Dim Decal_Obj As Variant Sub rec() PTA = ThisDrawing.Utility.GetPoint(, "Indiquer le premier coin :") 'PTB = ThisDrawing.Utility.GetPoint(, "Indiquer le second coin") 'possible de répondre sur la ligne de commande en 2 fois : x puis y Dim deltax As Double Dim deltay As Double deltax = ThisDrawing.Utility.GetReal("Entrer delta x: ") deltay = ThisDrawing.Utility.GetReal("Entrer delta y: ") PTB(0) = PTA(0) + deltax PTB(1) = PTA(1) + deltay points(0) = PTA(0): points(1) = PTA(1) points(2) = PTB(0): points(3) = PTA(1) points(4) = PTB(0): points(5) = PTB(1) points(6) = PTA(0): points(7) = PTB(1) points(8) = PTA(0): points(9) = PTA(1) points(10) = PTB(0): points(11) = PTB(1) points(12) = PTB(0): points(13) = PTA(1) points(14) = PTA(0): points(15) = PTB(1) Set Obj_Decal = ThisDrawing.ModelSpace.AddLightWeightPolyline(points) With Obj_Decal .Closed = True .Update End With 'enchaine la commande ThisDrawing.SendCommand "_qdim" & vbCr End Sub

Bonjour, Je ne sais pas si cela répond vraiment. J ai essayé de bidouiller un truc qui demande sur la ligne de commande avant impression les objets à ne pas imprimer......à tester... Dim obj As AcadEntity Dim selection As AcadSelectionSet Public Sub pas_vu_pas_pris() 'indique les objets à ne pas imprimer Set selection = ThisDrawing.SelectionSets.Add("truc") selection.SelectOnScreen For Each obj In selection obj.Visible = False Next End Sub Private Sub AcadDocument_BeginPlot(ByVal DrawingName As String) 'évènement impression pas_vu_pas_pris End Sub Public Sub revoir() 'pour revoir les objets invisibles For Each obj In ThisDrawing.ModelSpace If obj.Visible = False Then obj.Visible = True Next End Sub Public Sub ef() 'pour détruire truc ThisDrawing.SelectionSets("truc").Delete End Sub

Bonjour. Est-ce que la commande super hatch du menu express (bonus) ne fait pas toutes ces choses ? nazemrap

Bonjour. Juste pour indiquer une piste depuis vba. Je pense que de s'appuyer sur le développement est ce qui se rapproche le plus des possibilités de fabrication. Voilà où j'en suis avec 4 commandes successives en vba, sans polyligne 3d avec des solides. 1 les herses (pas indispensable) 2 le développement de la ligne de limon (la base) 3 monter le système marches (et contremarches) en 3d 4 le limon 3d depuis le développement. http://premiumorange.com/technaulogis/zz_cadxp_escalier_1.jpg

Bonjour. Je fais une tentative d'explication qui est une procédure, utilisant les menus déroulants pour la création d'une fenêtre. Des éléments doivent être dessinés dans l'environnement objet. 1 Activation de la présentation 2 Mise en page "fichier" > "gestionnaire des mises en pages" réglage traceur réglage papier(dimension, orientation) échelle 1=1 3 Création d'une fenêtre "affichage" > "fenêtres" > "1 fenêtre" en réponse tracer comme un rectangle Les objets dessinés dans l'environnement objet doivent être visibles dans la fenêtre. 4 Cliquer 2 fois gauche dans la fenêtre pour la rendre courante (cadre épaissi) 5 Faire une commande "zoom" en réponse à la ligne de commande, inscrire le coefficient* suivi de XP et valider. la mise à l' échelle doit se faire. * Calcul du coefficient échelle fractionnaire souhaitée exemple 1/50 dessin effectué en millimètres : 1/50 soit 1mm/50 mm soit le résultat de la division 0.02xp conversion dans l'unité écran exemple dessin effectué en mètres : 50 mm=0.05 m 1/0.05 soit 1mm/0.05 m soit le résultat de la division 20xp 6 Retour en espace papier pour impression 1=1 nazemrap

Bonjour à tous. Heuu!....Est-ce que les macros vba fonctionnent sous LT97 ? Merci pour les réponses. nazemrap

Par contre il semble que ça marche en décomposant le bloc. Il faut donc travailler sur des copies des blocs, pour les exploser sans les perdre. Mais il faut le faire avant de boucler puisque la commande "copie" ne fonctionne pas dans dans une itération.

Bonjour. J'avais pensé aussi à la méthode "intersectwith", mais elle semble fonctionner sur le principe de la "boundingbox". Je viens de tester la réponse est faussée. Il me semble qu'en copiant le bloc puis en l explosant, et pour chaque objet le constituant vérifier par "intersectwith". Un peu long m'enfin.. nazemrap

Bonjour. Je ne sais pas si cela va répondre exactement. mais en traçant un arc > 3 points par le milieu des segments perpendiculaires à la courbe et joignant la droite.... nazemrap [Edité le 31/5/2006 par nazemrap]

Bonjour. Est-ce que, avant d'envisager la macro, le mode de sélection rapide pourrait peut-être suffire ? nazemrap

Bonjour. A la suite de la largeur inscrire [surligneur]\X [/surligneur] suivis de la hauteur. nazemrap