KSJ77

Bonjour, Je souhaiterai de l'aide pour modifier le lisp ci dessous. Il s'agit d'un lisp qui permettrait de relier des prises terminales informatique à une baie suivant un chemin de câble (le but final est de récupérer les longueurs et de les mettre en attribut dans chaques prises). Je cherche à modifier ce dernier afin que les tracés s'effectuent suivant un tracé prédéfini d'un chemin de cable (en polyligne) et non en direct comme l'exemple joint. Savez vous si il existe un lisp plus adéquate que celui ci? Es ce que c'est possible avec ce lisp? (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:CABLAGE_VDI ( / js dxf_cod mod_sel n lremov ename l_pt l_pr key) (princ "\nChoix d'un objet modèle pour le filtrage: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*LINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0))) (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) (initget "Unique Tout Manuel _Single All Manual") (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]<Manuel>: ")) "Single") (setq n -1) (if (eq mod_sel "All") (setq js (ssget "_X" dxf_cod) n -1) (setq js (ssget dxf_cod) n -1) ) ) (repeat (sslength js) (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n))))) (setq l_pr (list 'StartPoint 'EndPoint 'Center 'InsertionPoint 'Coordinates 'FitPoints)) (foreach n l_pr (if (vlax-property-available-p ename n) (setq l_pt (if (or (eq n 'Coordinates) (eq n 'FitPoints)) (append (if (eq (vla-get-ObjectName ename) "AcDbPolyline") (l-coor2l-pt (vlax-get ename n) nil) (if (and (eq n 'FitPoints) (zerop (vlax-get ename 'FitTolerance))) (l-coor2l-pt (vlax-get ename 'ControlPoints) T) (l-coor2l-pt (vlax-get ename n) T) ) ) l_pt ) (cons (vlax-get ename n) l_pt) ) ) ) ) ) (cond (l_pt (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (redraw) (cond ((eq (car key) 5) (foreach n l_pt (grdraw (trans n 0 1) (cadr key) 3) ) ) ) ) (if (eq (car key) 3) (foreach n l_pt (command "_pline" "_none" (trans n 0 1) "_none" (cadr key) "") ) ) (redraw) ) ) (prin1) ) Merci d'avance à ceux qui pourront m'aider Cablage VDI.zip

Bonjour tout le monde, Pouvez vous remettre un lien pour le lisp "ProtOng.VLX" le lien ci dessus n'est plus valide. Merci.

Bonjour, Je corrige ce que j'ai dit plus haut, la fonction EATT avec remplacement d'un fichier existant (xls) n'efface pas la macro si elle est déjà existante. Pour l'instant j'ai modifiée la routine EATT de Gile afin d'exporter les attributs dans la feuil2 d'un fichier .xls existant afin d'avoir de garder les formules dans la feuil1 (formules en liaison avec feuil2) Cordialement

Bonjour, Ce ne serait pas plutot la routine EATT/IATT de Gile? Le problème c'est qu'une macro dans un fichier excel sera écrasé par l'enregistrement du fichier *.xls lors de la commande EATT (enregistrement avec remplacement du fichier excel). J'ai tenté de modifié le "ExcelAttribute.dll" à partir des codes source mise à dispo par Gile, mais je ne m'y connait pas assez en Visual Basic. Plusieurs possiblités: - soit d'exporter les attributs dans la feuil2 d'un fichier .xls existant afin d'avoir de garder les formules dans la feuil1 (formules en liaison avec feuil2) - soit de modifier le "ExcelAttribute.dll" afin d'y intégrer directement mes formules (avec des cellules au format nombre ou standard) - soit de trouver une lisp avec possibilité d'y intégrer des formules puis d'exporter sous excel. Cordialement

Bonjour, Je suis a la recherche d'une routine (en lisp ou vb) qui serait capable de faire la chose suivante: 1/ recuperer les blocs de la selection courante ou selectionner les blocs 2/ extraire les attributs vers excel 3/ ajouter les formules dans la feuille excel en C31, C32, C33, C34, D31, D32, D33, E31, E32, E33, F31, F32, F33 comme le fichier ci joint 4/ enregistrer le fichier en .xls 5/ ouvrir le fichier excel Merci d'avance calcul puissance.xls.zip

Bonjour, Tout d’abord je tiens à préciser que je suis débutant en terme de programmation sur visual basic. Je souhaiterai modifier le programme afin d'y insérer une ou plusieurs formules dans le fichier excel (somme et multiplication sur les valeurs d'attribut). J'ai téléchargé le code source, pourriez vous me dire quelle classes il faut modifier et où insérer les commandes du style : "oXLWsheet.Range("N4").Formula = "=SUM(oXLWsheet!B4:M4)"? En pièce jointe, le résultat que j'aimerai obtenir avec la commande EATT Merci d'avance calcul puissance.zip

Merci beaucoup :)

Bonjour à tous, Je cherche à modifier le programme VBA ci dessous afin qu'il n'extrait les attributs que des blocs ayant le nom "Repère". Pourriez vous m'aider, je ne trouve pas la solution. Cordialement 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 ' 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 Row = Row + 1 ' Ligne suivante End If End If Next MsgBox "Les attributs du dessin " & Cells(1, 1).Text & " ont été extraits avec succès." End Sub

Bonjour, Dans le cadre de dessiner des pieuvres électrique, je suis à la recherche d'une routine qui me permettrait de raccorder plusieurs blocs par des polylignes de 2/3 segments après avoir sélectionné de ces derniers. La procédure serait la suivante: 1/ Sélection du bloc qui correspond à la boite de dérivation. 2/ Sélection des blocs qui correspondent aux interrupteurs. 3/ Sélection des blocs qui correspondent aux luminaires. 4/ Traçage automatique des polylignes (avec 2/3 segments) partant de la boite de dérivation aux interrupteurs et aux luminaires Ci-joint un exemple du résultat souhaité: Dans l'attente d'un programme Lisp adéquat, je vous souhaite une excellente semaine :)