sean-01

Bonjour, Il s'agit des blocs dynamiques. C'est puissant mais assez ardu à mettre en oeuvre. Il faut créer un bloc puis utiliser la palette de création des blocs afin de choisir les différents paramètres. Pour comprendre le plus simple c'est de sélectionner le bloc existant et de l'éditer dans "L'editeur de bloc" et penser à l'aide d'autocad. A+ [Edité le 1/6/2010 par sean-01]

Voilà, tout est dans le sujet. Et ça m'arrangerait bien A+ [Edité le 27/5/2010 par sean-01]

Bonjour Si c'est un Autocad complet, il est possible de créer un champ couleur dans les propriétés du dessin onglet Ajouter saississer le Nom Couleur puis une couleur OK Puis su l'attribut Clic droit 'inserer un champ' dans categories de champ selectionner document Puis dans noms de champs Couleur Ainsi l'attribut est lié à la propriétés du dessin et en plus cette valeur peut etre lue même si le fichier est fermé (propriètès du fichier) Salutations [Edité le 29/4/2010 par sean-01]

Bonjour Voici la suite de mes recherches, je les mets à disposition de chacun, pour vérification, modification et correction éventuelles, et transfo en VB.net Inspiré des lispeurs, Programme QBRICK et autres A + Option Explicit Sub coupe_entité() '----- Codé le 26/04/10 par J-A NAVECTH ----- 'Ce programme à pour but de trouver les intersections entre différentes polylignes 3d, 'et de les scinder aux points d'intersections 'Il ne fonctionne pas pour les lignes (bug quelque part ?),ni pour les polyligne 2d 'recherche_extremite_polyline() non codé ' ' ' Dim ssetObj As AcadSelectionSet Dim compte_ssetobj As Integer Dim elem Dim tempObj1(0) As AcadObject Dim elem2 Dim tempObj2(0) As AcadObject Dim intersection Dim Incr2 As Integer Dim point_d_insertion(2) As Double Dim point_depart2(2) As Double Dim point_arrivée2(2) As Double Dim objretour(0) As AcadObject 'selection des objets qui s'entrecoupent test_selection: On Error Resume Next Set ssetObj = ThisDrawing.SelectionSets.Add("SSET") If Err Then Err.Clear ThisDrawing.SelectionSets("SSET").Delete GoTo test_selection End If ssetObj.SelectOnScreen 'je ne fais pas de test de validité des objets reinitialise_boucle: compte_ssetobj = ssetObj.Count For Each elem In ssetObj Set tempObj1(0) = elem For Each elem2 In ssetObj If elem.Handle <> elem2.Handle Then Set tempObj2(0) = elem2 intersection = tempObj2(0).IntersectWith(tempObj1(0), acExtendNone) 's'il existe une intersection au moins entre les deux elements ' Retrouve les coordonnées des intersections If UBound(intersection) > 0 Then For Incr2 = 0 To (UBound(intersection) - 2) / 3 point_d_insertion(0) = intersection(Incr2 * 3) point_d_insertion(1) = intersection(Incr2 * 3 + 1) point_d_insertion(2) = intersection(Incr2 * 3 + 2) recherche_extremite tempObj2(0), point_depart2, point_arrivée2 If distance_entre_points(point_d_insertion, point_depart2) > 0.000001 And _ distance_entre_points(point_d_insertion, point_arrivée2) > 0.000001 Then 'Verifie que l'intersection ne se trouve pas sur une extrèmité de l'élément puis le coupe en deux ssetObj.RemoveItems tempObj2 'Enlève l'élément de la sélection 'Car lors de la coupe l'élément est supprimé mais existe encore dans la sélection ??? If CoupeObjetAuPoint(tempObj2(0), point_d_insertion, objretour(0)) Then 'ajoute les éléments créé à la sélection ssetObj.AddItems objretour ssetObj.AddItems tempObj2 GoTo reinitialise_boucle Else Debug.Assert 0 'Si la coupe n'a pas eu lieu remet l'élément dans la sélection ssetObj.AddItems tempObj2 End If End If Next End If End If Next Next End Sub Function CoupeObjetAuPoint(Object, pointObj, obj_retour) Dim nombre_d_objet As Integer Dim strh As String Dim strp1 As String CoupeObjetAuPoint = False nombre_d_objet = ThisDrawing.ModelSpace.Count ThisDrawing.SetVariable "CMDECHO", 0 strh = Object.Handle strp1 = Replace(CStr(pointObj(0)), ",", ".") & "," & _ Replace(CStr(pointObj(1)), ",", ".") & "," & _ Replace(CStr(pointObj(2)), ",", ".") ThisDrawing.SendCommand "_BREAK " & _ "(handent " & Chr(34) & strh & Chr(34) & ")" & _ vbCr & strp1 & vbCr & strp1 & vbCr ThisDrawing.SetVariable "CMDECHO", 1 If nombre_d_objet = ThisDrawing.ModelSpace.Count - 1 Then Set Object = ThisDrawing.ModelSpace(nombre_d_objet - 1) Set obj_retour = ThisDrawing.ModelSpace(nombre_d_objet) CoupeObjetAuPoint = True ElseIf nombre_d_objet = ThisDrawing.ModelSpace.Count Then Debug.Assert 0 Else CoupeObjetAuPoint = False End If End Function Private Function recherche_extremite(objretour, point_depart, pointarrivée) If objretour.ObjectName = "AcDbPolyline" Then recherche_extremite = recherche_extremite_polyline(objretour, point_depart, pointarrivée) ElseIf objretour.ObjectName = "AcDbLine" Then recherche_extremite = recherche_extremite_line(objretour, point_depart, pointarrivée) ElseIf objretour.ObjectName = "AcDb3dPolyline" Then recherche_extremite = recherche_extremite_polyline3d(objretour, point_depart, pointarrivée) Else: Debug.Assert 0 End If End Function Private Function recherche_extremite_polyline3d(Object, point_depart, pointarrivée) Dim point Dim i As Integer point = Object.Coordinate(0) For i = 0 To 2 point_depart(i) = point(i) Next i = (UBound(Object.Coordinates) - 2) / 3 point = Object.Coordinate(i) For i = 0 To 2 pointarrivée(i) = point(i) Next End Function Private Function recherche_extremite_polyline(objretour, point_depart, pointarrivée) 'non codé a vous de jouer Debug.Assert 0 End Function Private Function recherche_extremite_line(objretour, point_depart, pointarrivée) Dim point Dim i As Integer point = objretour.StartPoint For i = 0 To 2 point_depart(i) = point(i) Next point = objretour.EndPoint For i = 0 To 2 pointarrivée(i) = point(i) Next End Function Function distance_entre_points(coord1, coord2) As Double Dim i As Integer For i = 0 To UBound(coord1) distance_entre_points = distance_entre_points + (coord1(i) - coord2(i)) ^ 2 Next distance_entre_points = distance_entre_points ^ 0.5 End Function

Debut de solution http:// http://cadxp.cadmag.info/sujetXForum-27597.htm Ensuite je pense qu'il faut utiliser les fonctions mesurer ou diviser Mais c'est pas gagné Voir chez les Lispeurs ils sont forts ca ressemble assez a ca http:// http://cadxp.cadmag.info/sujetXForum-11417.htm http:// http://cadxp.cadmag.info/sujetXForum-24936.htm

Suite à ma demande j'ai cherché, cherché, .... et trouvé :) Voici un code Succinct il ne reprend pas les fonctionnalités de l'original mais c'est pour l'exemple Sub cptg() Set ss = ThisDrawing.PickfirstSelectionSet ss.Clear 'selectionne un premier point fpt = ThisDrawing.Utility.GetPoint(, "Pick first point") ss.Select acSelectionSetCrossing, fpt, fpt 'selectionne le second point spt = ThisDrawing.Utility.GetPoint(, "Pick second point") 'recupére Handle de l'entité strh = ss.Item(0).Handle 'Moulinette qui remplace les point par des virgules que je sais pas pourquoi strp1 = Replace(CStr(fpt(0)), ",", ".") & "," & _ Replace(CStr(fpt(1)), ",", ".") & "," & _ Replace(CStr(fpt(2)), ",", ".") strp2 = Replace(CStr(spt(0)), ",", ".") & "," & _ Replace(CStr(spt(1)), ",", ".") & "," & _ Replace(CStr(spt(2)), ",", ".") 'commande Break qui va bien ThisDrawing.SendCommand "_BREAK " & _ "(handent " & Chr(34) & strh & Chr(34) & ")" & _ vbCr & strp1 & vbCr & strp2 & vbCr 'pour info Handent donne l'ObjectID de l'entité End Sub 'les commentaires désobligeant sont de mon fait :casstet: Voici l'original http:// http://forums.augi.com/showthread.php?t=58553 [surligneur] Aide-toi et le ciel t'aidera[/surligneur] [Edité le 21/4/2010 par sean-01]

Désolé, Mais ce code doit pouvoir se traduire en VB.net ou autre logiciel de programation intégré à AutoCad

Bonjour Je ne connais pas le LISP mais voici code simple en VB Sub modifechelle() Dim Rapport_d_echelle As Double Dim i As Integer Rapport_d_echelle = InputBox("Saissisez le rapport d'échelle", "Change echelle ligne", 1) 'parcours tous les élements de l'espace For i = 0 To ThisDrawing.ModelSpace.Count On Error Resume Next 'modifie l'echelle si elle existe ThisDrawing.ModelSpace(i).LinetypeScale = Rapport_d_echelle * ThisDrawing.ModelSpace(i).LinetypeScale Next End Sub Si ca peut aider?

Bonjour à tous Je parcours ce forum depuis quelque temps et j'y ai trouvé beaucoup de réponses à mes questions. Mais voila j'ai un problème. Je souhaiterais pouvoir couper une polyligne en un point donné (en VB ou VBA) j'ai trouvé un debut de réponse sur le fil suivant cf lien suivant : http:// http://cadxp.cadmag.info/sujetXForum-24936.htm ;; cptg coupure pour Thierry Garré (defun c:cptg (/ o p1 a l p2) (setq o (entsel "\n Coupure selectionnez l'objet: ")) (redraw (car o) 3) (setq p1 (getpoint "\n 1er point de coupure :") a (getangle p1 "\n orientation coupure :") l (getdist "\n longueur de la coupure :") p2 (polar p1 a l)) (command "_break" o "_f" "_none" p1 "_none" p2) ) Je transforme la commande lisp suivante (command "_break" o "_f" "_none" p1 "_none" p2) en commande VBA ThisDrawing.SendCommand "_break " [surligneur] Selection [/surligneur]Point1 point2 Mais je ne sais pas quel sélection utiliser : nom de l'objet, Handle, une colection, un "SelectionSet" ou autre? J'ai essayé diverses solutions et aucune ne fonctionne. Merci pour votre aide. NB : Si j'utilise VBA c'est que j'avais commencé à programmer sous EXCEL. Question qui me parait complémentaire. http:// http://cadxp.cadmag.info/sujetXForum-27417.htm

Bonjour, Concernant ce pb j'utilise les fonctions copier coller. dans une feuille excel la premiere colonne contenat les abcisses, la deuxieme les ordonnées la troisieme une fonction de concaténation des deux precedentes =A2&","&B2 Il suffit de copier la troisème colonne et de lancer la fonction polyligne dans autocad puis de coller les valeurs: la courbe se dessine. C'est rustique, limité mais ça peux aider 0 6.978357397 0,6.97835739666595 5 5.623831171 5,5.62383117090802 10 6.687163962 10,6.68716396222385 15 6.479591118 15,6.4795911181239 20 5.745666026 20,5.74566602583787 25 0.572360678 25,0.572360678446042 30 9.925332907 30,9.92533290661713 35 2.592941622 35,2.5929416218726 40 6.99714712 40,6.99714711999913 45 0.278571698 45,0.278571698207533 50 4.737490642 50,4.737490642409 55 1.461310383 55,1.46131038265724 60 3.624809421 60,3.62480942139657 65 0.981811642 65,0.981811641560646 70 7.521027254 70,7.52102725358902 75 1.385719726 75,1.38571972583808 80 8.242637847 80,8.24263784706464 85 6.62001771 85,6.62001771043544 90 8.479526985 90,8.47952698512089 95 8.252384748 95,8.25238474771909 100 2.652669326 100,2.65266932639665 105 6.161879429 105,6.16187942906961 110 5.257663248 110,5.25766324775047 115 1.4264472 115,1.42644720017706 120 1.618963894 120,1.61896389381069 125 7.645374485 125,7.64537448501558 130 3.713198118 130,3.71319811811051 135 8.683027009 135,8.6830270088815