Aller au contenu

rahim853

Membres
  • Compteur de contenus

    6
  • Inscription

  • Dernière visite

rahim853's Achievements

Newbie

Newbie (1/14)

0

Réputation sur la communauté

  1. Bonjour, qlq un peut m aider, quant j exécute la macro suivante j ai une erreur 2147418113(8000fff)' lors de l exécution de la boucle sur next; a soivoir sur mon dessin il y a des lignes , des polyline et des bolck Dim pointsArray(0 To 11) As Double pointsArray(0) = 148: pointsArray(1) = 142: pointsArray(2) = 0 pointsArray(3) = 180: pointsArray(4) = 114: pointsArray(5) = 0 pointsArray(6) = 339: pointsArray(7) = 114: pointsArray(8) = 0 pointsArray(9) = 344: pointsArray(10) = 142: pointsArray(11) = 0 Dim ssetObj As AcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET2") ssetObj.SelectByPolygon acSelectionSetCrossingPolygon, pointsArray ssetObj.Highlight True Dim entry As AcadEntity For Each entry In ssetObj MsgBox entry.ObjectName Next
  2. rahim853

    sommets d une polyligne

    j ai pu trouver un petit code mais j ai encore des probleme avec les dimension de la table voila ce que j ai fais Dim objPoly As AcadLWPolyline Dim varPoint As Variant Dim dbCorner(0 To 2) As Double Dim strText As String Dim dbWidth As Double Dim objMText As AcadMText Dim basePnt As Variant Dim NbPoints As Integer ThisDrawing.Utility.GetEntity objPoly, basePnt, "Selectionner une polyligne :" For Each Coordinate In objPoly.Coordinates NbPoints = NbPoints + 1 Next TableauCoord = objPoly.Coordinates For i = 0 To NbPoints - 1 Next Dim MyModelSpace As IAcadModelSpace2 Set MyModelSpace = ThisDrawing.ModelSpace Dim Pt As Variant Dim MyTable As AcadTable Pt = ThisDrawing.Utility.GetPoint 'Set MyTable = MyModelSpace.AddTable(Pt, NbPoints / 2 + 1, 2, 0.7, 1) Set MyTable = MyModelSpace.AddTable(Pt, NbPoints / 2 + 1, 2, 1, 30) MyTable.TitleSuppressed = False MyTable.SetText 0, 0, "coordonnées" k = -2 j = -1 For i = 1 To NbPoints / 2 MyTable.SetText i, 0, FormatNumber(TableauCoord(k + 2), 2) MyTable.SetText i, 1, FormatNumber(TableauCoord(j + 2), 2) k = k + 2 j = j + 2 Next ZoomExtents aire = objPoly.Area MsgBox "Cette polyligne à : " & NbPoints / 2 & " pts(x,y)" & aire End Sub
  3. bonjour a tous, je cherche comment faire , pour recuperer les coordonnées des sommet d une polyligne( on la selectionnant sur ecran) puis inserer un tableau contenant ces coordonnées dans le dessin merci
  4. merci gile; j ai pu detourner le probleme en determinat le nom d un block ou se situe un point donné je vous laisse voir ce que j ai fais Private Sub essai Click() 'lancer autocad 2008 ou 2009 On Error Resume Next Set acadApp = GetObject(, "AutoCAD.Application.17") If Err Then Err.Clear Set acadApp = CreateObject("AutoCAD.Application.17") If Err Then MsgBox Err.Description Exit Sub End If End If 'ouvrir le ficheir essai se trouvant dans le repertoire de l application acadApp.Documents.Open (App.Path & "\essai.dwg") 'Rendre l application visible acadApp.Visible = True 'faire un zoom acadApp.Application.ZoomAll Dim blok As AcadBlockReference ' Determination d'un point Dim Pt1(0 To 2) As Double Pt1(0) = inputbox("Saisir le X du point") Pt1(1) = inputbox("Saisir le Y du point") Pt1(2) = 0 ' Création d'un rayon horizontal passant par le point Dim Pt2(0 To 2) As Double Dim points As Variant Pt2(0) = Pt1(0) + 1 Pt2(1) = Pt1(1) Pt2(2) = Pt1(2) Dim Ray As AcadRay Set Ray = acadApp.Application.ActiveDocument.ModelSpace.AddRay(Pt1, Pt2) Dim OBJET As AcadEntity Dim IntCodeDXF(0) As Integer Dim ValCodeDXF(0) As Variant Dim objJeu As AcadSelectionSet ' selection de tous les objet sur le calque Set objJeu = acadApp.Application.ActiveDocument.SelectionSets.Add("Jaax") IntCodeDXF(0) = 0: ValCodeDXF(0) = "INSERT" objJeu.Select acSelectionSetAll ' faire filtrer les objets pour qu il reste seul les blocks 'et faire une boucle pour determiner le nom du block dans lequelle se trouve notre point For Each OBJET In objJeu If OBJET.ObjectName = "AcDbBlockReference" Then Set blok = OBJET points = blok.IntersectWith(Ray, acExtendNone) Dim NbrePoints As Integer NbrePoints = UBound(points) / 3 ' Détermination en fonction de la parité If NbrePoints Mod 2 = 0 Then MsgBox "Le point n'est pas dans le contour" & blok.Name Else MsgBox "Le point est dans le contour du" & blok.Name End If End If Next Ray.Delete acadApp.Quit End Sub
  5. bonjour, j ai deja debuter avec mon programme, je suis en VB et j ai pas le temps en ce moment pour apprendre le lisp merci pour toute suggestion
  6. bonjour a tous je debute en vba , alors je veux faire une macro qui me permet ceci: j ai un dessin , sur un calque defini, j ai des polylgnes , a chaque polyligne je veux lui attaché un nom d une region(xdata), aprés je fais saisir le une ligne , alors la macro me permetterais de determiner la polyligne (avec son xdata) avec qui la ligne s intersecte. Y-a-t'il un expert en VBA ou en VB qui à la solution ?? moi j attaque autocad depuit VB6 merci a tous
×
×
  • 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é