timhothels

vas voir dans le post: Insertion de bloc grace a vb J'ai mis un code complet permettant d'inserer des blocs.

je crois que si.... Regarde ici j'emploie une echelle à 0.25 mais tu peux mettre tous ce ke tu veux. :D

OK je sais comment faire Voici deux méthodes différentes: la il va prendre en compte si il y a autre chose dans le rectangle et hachurer que la zone souhaité comme si on fait pickpoint dans autocad '***************************************************************************************** '*Fonction permettant de Dessiner un rectangle et de l'hachurer grace a la commande batch* '***************************************************************************************** Public Sub DessinerHachureDessin1(x As Double, y As Double, TypeHachure As Long, NomHachure As String, H As Double, Larg As Double, EchelleHachure As Double, PointXHachure As Double, PointYHachure As Double) Dim objHachure As AcadHatch, PointHachure(0 To 2) As Double Dim Rectangle(0 To 3) As AcadLine, PickPoint(0 To 1) As Double Dim Point1(0 To 2) As Double, Point2(0 To 2) As Double, Point3(0 To 2) As Double, Point4(0 To 2) As Double 'création des différents points Point1(0) = x: Point1(1) = y: Point1(2) = 0 Point2(0) = x: Point2(1) = y + H: Point2(2) = 0 Point3(0) = Larg: Point3(1) = y + H: Point3(2) = 0 Point4(0) = Larg: Point4(1) = y: Point4(2) = 0 '*Creation des lignes* Set Rectangle(0) = Feuille.ModelSpace.AddLine(Point1, Point2) Set Rectangle(1) = Feuille.ModelSpace.AddLine(Point2, Point3) Set Rectangle(2) = Feuille.ModelSpace.AddLine(Point3, Point4) Set Rectangle(3) = Feuille.ModelSpace.AddLine(Point4, Point1) 'création des hachures Set objHachure = Feuille.ModelSpace.AddHatch(TypeHachure, NomHachure, True) Feuille.SendCommand ("-bhatch p ar-conc 0.25 0 " & PointXHachure & "," & PointYHachure & vbCrLf) 'on efface les lignes que l'on doit pas voir Rectangle(0).delete Rectangle(2).delete Rectangle(3).delete End Sub '*************************************************************** '*Fonction permettant de Dessiner un rectangle et de l'hachurer* '*************************************************************** Public Sub DessinerHachureDessin2(x As Double, y As Double, TypeHachure As Long, NomHachure As String, H As Double, Larg As Double, EchelleHachure As Double) Dim objHachure As AcadHatch, PointHachure(0 To 2) As Double Dim Rectangle(0 To 3) As AcadLine, PickPoint(0 To 1) As Double Dim Point1(0 To 2) As Double, Point2(0 To 2) As Double, Point3(0 To 2) As Double, Point4(0 To 2) As Double 'création des différents points Point1(0) = x: Point1(1) = y: Point1(2) = 0 Point2(0) = x: Point2(1) = y + H: Point2(2) = 0 Point3(0) = Larg: Point3(1) = y + H: Point3(2) = 0 Point4(0) = Larg: Point4(1) = y: Point4(2) = 0 '*Creation des lignes* Set Rectangle(0) = Feuille.ModelSpace.AddLine(Point1, Point2) Set Rectangle(1) = Feuille.ModelSpace.AddLine(Point2, Point3) Set Rectangle(2) = Feuille.ModelSpace.AddLine(Point3, Point4) Set Rectangle(3) = Feuille.ModelSpace.AddLine(Point4, Point1) ' PickPoint(0) = 499 'PickPoint(1) = 1240 'création des hachures Set objHachure = Feuille.ModelSpace.AddHatch(TypeHachure, NomHachure, True) objHachure.AppendOuterLoop (Rectangle) objHachure.PatternScale = EchelleHachure objHachure.Evaluate 'on efface les lignes que l'on doit pas voir Rectangle(0).delete Rectangle(2).delete Rectangle(3).delete End Sub

Voici le code au cas ou: '******************************************* 'FONCTION POUR INSERER UN BLOC DANS AUTOCAD* '******************************************* Public Sub InsererBloc(Nom_Bloc As String, x As Double, y As Double, echelleX As Double, echelleY As Double) Dim objdoc As AcadDocument Dim objBlockRef As AcadBlockReference Dim objUtil As AcadUtility Dim Point As Variant Dim insertionPnt(0 To 2) As Double Set objdoc = Feuille Set objUtil = objdoc.Utility insertionPnt(0) = x: insertionPnt(1) = y: insertionPnt(2) = 0# If Feuille.ActiveSpace = acModelSpace Then Set objBlockRef = Feuille.ModelSpace.InsertBlock(insertionPnt, Nom_Bloc, echelleX, echelleY, 1#, 0#) Else Set objBlockRef = Feuille.PaperSpace.InsertBlock(insertionPnt, Nom_Bloc, echelleX, echelleY, 1, 0) End If 'on explose les blocs pour que le texte des cotations soient de meme taille objBlockRef.Explode 'il faut l'effacer car sinon on a 2 blocs superposés objBlockRef.delete objAcad.Update End Sub

C bon g trouvé voici le code au cas ou ca interesserait kkun '***************************************************************************************** '*Fonction permettant de Dessiner un rectangle et de l'hachurer grace a la commande batch* '***************************************************************************************** Public Sub DessinerHachureDessin1(x As Double, y As Double, TypeHachure As Long, NomHachure As String, H As Double, Larg As Double, EchelleHachure As Double, PointXHachure As Double, PointYHachure As Double) Dim objHachure As AcadHatch, PointHachure(0 To 2) As Double Dim Rectangle(0 To 3) As AcadLine, PickPoint(0 To 1) As Double Dim Point1(0 To 2) As Double, Point2(0 To 2) As Double, Point3(0 To 2) As Double, Point4(0 To 2) As Double 'création des différents points Point1(0) = x: Point1(1) = y: Point1(2) = 0 Point2(0) = x: Point2(1) = y + H: Point2(2) = 0 Point3(0) = Larg: Point3(1) = y + H: Point3(2) = 0 Point4(0) = Larg: Point4(1) = y: Point4(2) = 0 '*Creation des lignes* Set Rectangle(0) = Feuille.ModelSpace.AddLine(Point1, Point2) Set Rectangle(1) = Feuille.ModelSpace.AddLine(Point2, Point3) Set Rectangle(2) = Feuille.ModelSpace.AddLine(Point3, Point4) Set Rectangle(3) = Feuille.ModelSpace.AddLine(Point4, Point1) 'création des hachures Set objHachure = Feuille.ModelSpace.AddHatch(TypeHachure, NomHachure, True) Feuille.SendCommand ("-bhatch p ar-conc 0.25 0 " & PointXHachure & "," & PointYHachure & vbCrLf) 'on efface les lignes que l'on doit pas voir Rectangle(0).delete Rectangle(2).delete Rectangle(3).delete

est ce ke kelkun connait la commande -bhatch car il faudrait ke je la tape avec ts les parametres nécéssaires en une ligne!!!! merci

bonjour, je dois faire une hachure depuis mon programme vb. Mais il faut ke je la fasse en selection un point et non en selectionnant un objet et je ne trouve pas la solution.. Si quelqu'un trouve.... Merci :D

je dois aussir faire des hachures en choisissant 1 point mais en vba. Est ce aque kelkun peut m'aider??

Probleme résolu

j'ai creer une macro vba sous autocad afin de pouvoir insérer des blocs... Seulement je dois passer des parametres a ma fonctions mais je ne sais pas comment faire pour passer ces parametres lors de l"appel de ma maccro dans mon programme vb. Merci de votre aide!

Bonjour, j'aimerais savoir comment on peut insérer et déplacer des blocs à des endroits bien précis grâce à vba. merci[Edité le 29/3/2005 par timhothels] [Edité le 29/3/2005 par timhothels]