ce matin j'ai du imprimer des carnet de détails de ferraillages.... 62 A4 à imprimer en mode objet par des fenêtres... grrrr

j'ai bien essayer de me servir du module de covadis qui est si pratique pour imprimer les profils en travers..... mais ça me les sortais pas dans l'ordre... et je suis pas arrivé a trouver la logique pour avoir un ordre coérant....(j'ai essayer de faire tous mes cadres 1 à 1 dans l'ordre, metre tous les dessins à la queu lele... rien n'y a fait du coup j'ai remis les feuilles dans l'ordre aprés impréssion)

le principe, c qu'on met les cadre de A4 dans un calque spécial, et aprés avoir régler une boite de dialogue proche de celle de l'impréssion normale (imprimente, format, ctb.. et calque des cadres) on selectione tous les calque a imprimer et ça balance tout ça a pdfcréator...

là je fait "wait", quand tout est dans la fille d'attente, je les sélectionnes, puis combine (avec un clic droite et quand je print le résultat, j'ai un pdf de mon carnet...

bon, la combine sur pdf créator marche... mais quand je suis pas sur mon poste, je doit me palucher toute les impressions à la main et c un vrai boulot de robot.....

si un lispeur fou à un peu de temps a me consacrer, je me doute que ça doit pas être de la tarte, mais une macro qui retrouve les cadres (dans l'ordre de création des polygone ce serai le top) et me passe ça à la moulinette, je n'aurai pas assés de mot pour lui exprimer ma reconnaissance....

merci d'avance à nos codeurs psychopathe :)

je voudrais ouvrir le fichier *.CTB lier a ma présentation  en cours de facon plus rapide, sans passer par le gestionnaire de fichier windows.

mais je bloque avec le "OPEN",

j'ai une erreur  

type d'argument incorrect: VLA-OBJECT "C:\\pERSO\\Plot Styles\\1-50 NOIR.ctb"

une solution ?

Merci

(defun c:open_ctb_presentation (/) 
 (setq repertoirectb "C:\\PERSO\\Plot Styles"  )
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for lay (vla-get-layouts doc)
     (if (/= (vla-get-name lay) "Model")
       (progn (setq test33 lay
                     table1 (vla-get-stylesheet lay)
                              )
         (setq blkname (vla-open (strcat "C:\\pERSO\\Plot Styles\\" table1 )))
            ;;((vla-open (vla-get-documents (vlax-get-acad-object)) blkname))
             (if (/= blkname nil)
               (prompt "\n le fichier CTB a été ouvert")
             )
  )
      )
    )
      (princ)
  )

Phil

J'utilise ce LISP pour Tout mettre en blanc (je récupère un morceau de plan pour le mettre sur une page de garde de dossier sous Excel et il faut qu'il soit en blanc).
Le problème est que les blocs se fichent bien du LISP et gardent une couleur éclatante...
Ils contiennent du texte et si je les décompose je récupère le nom de l'attribut et non plus sa valeur.
Merci pour votre aide.
 

(defun c:Blanc ()
  (vl-load-com)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq modelSpace (vla-get-ModelSpace doc))

  ;; Demander à l'utilisateur de sélectionner les objets
  (setq selectionSet (ssget))

  (if selectionSet
    (progn
      ;; Fonction pour modifier la couleur des objets tout en préservant le type de ligne
      (defun ChangerCouleur (obj)
        (if (vlax-property-available-p obj 'Color)
          (vla-put-Color obj 7) ;; Blanc (Index couleur 7)
        )
        (if (vlax-property-available-p obj 'Linetype)
          (setq linetype (vla-get-Linetype obj)) ;; Sauvegarde du type de ligne
        )
        (if linetype
          (vla-put-Linetype obj linetype) ;; Réapplication du type de ligne
        )
      )

      ;; Modifier les objets sélectionnés
      (setq i 0)
      (repeat (sslength selectionSet)
        (setq obj (vlax-ename->vla-object (ssname selectionSet i)))
        (ChangerCouleur obj)
        (setq i (1+ i))
      )

      ;; Modifier les objets dans les blocs sélectionnés uniquement
      (setq i 0)
      (repeat (sslength selectionSet)
        (setq obj (vlax-ename->vla-object (ssname selectionSet i)))
        (if (eq (vla-get-ObjectName obj) "AcDbBlockReference")
          (progn
            (setq blkName (vla-get-EffectiveName obj))
            (setq blk (vla-item (vla-get-Blocks doc) blkName))
            (vlax-for blkObj blk
              (ChangerCouleur blkObj)
            )
            ;; Déplacer les blocs vers le calque "0"
            (if (vlax-property-available-p obj 'Layer)
              (vla-put-Layer obj "0")
            )
          )
        )
        (setq i (1+ i))
      )

      ;; Modifier la couleur des cotations sélectionnées uniquement (traits, texte et flèches)
      (setq i 0)
      (repeat (sslength selectionSet)
        (setq obj (vlax-ename->vla-object (ssname selectionSet i)))
        (if (or (wcmatch (vla-get-ObjectName obj) "*Dimension*")
                (eq (vla-get-ObjectName obj) "AcDbDimension"))
          (progn
            ;; Modifier la couleur des traits de cotation
            (ChangerCouleur obj)
            
            ;; Modifier la couleur du texte de cotation
            (if (vlax-property-available-p obj 'TextColor)
              (vla-put-TextColor obj 7)
            )
            
            ;; Modifier la couleur du MText si présent
            (if (vlax-property-available-p obj 'MText)
              (progn
                (setq mtextObj (vla-get-MText obj))
                (if mtextObj
                  (vla-put-Color mtextObj 7)
                )
              )
            )
            
            ;; Modifier la couleur des flèches, lignes d'attache et lignes d'extension
            (if (vlax-property-available-p obj 'Dimclrd)
              (vla-put-Dimclrd obj 7) ;; Couleur des lignes d'attache et de cote
            )
            (if (vlax-property-available-p obj 'Dimclrt)
              (vla-put-Dimclrt obj 7) ;; Couleur des flèches
            )
            (if (vlax-property-available-p obj 'Dimclre)
              (vla-put-Dimclre obj 7) ;; Couleur des lignes d'extension
            )
            
            ;; Déplacer les cotations et les lignes de repères vers le calque "1-FORT"
            (if (vlax-property-available-p obj 'Layer)
              (vla-put-Layer obj "1-FORT")
            )
          )
        )
        (setq i (1+ i))
      )
      
      (princ "\nLes objets sélectionnés, y compris les blocs (déplacés vers le calque 0) et les cotations (déplacées vers le calque 1-FORT), ont été mis en blanc tout en conservant leur type de ligne.")
    )
    (princ "\nAucune sélection effectuée.")
  )
  (princ)
)

 Je suis un nouveau adhèrent dans ce forum et j'ai utiliser le Lisp CPP.

Il marche bien et copie une fenêtre d'une présentation à une autre mais le problème qu'il ne garde pas l'état des calques, je ne sais pas est ce qu'il y en a un paramètre à changer ou quoi le problème.

merci.

un grand merci a tous les pros du lisp et a ce forum, pour tout ce qu'ils apportent.

Je suis cherche à savoir si il était possible d'intégré les blocs dynamiques, dans ce merveilleux lisp TABLOBLO de Mr Tramber.

Merci par avance.

Je cherche une routine LISP qui pour chaque calque présent dans un  fichier pourrait dupliquer une présentation "Modele" contenant une fenêtre et un texte simple.
La fenêtre n'afficherai qu'un seul calque par présentation, le nom de l'onglet ainsi que le texte de chaque serait le nom du calque.

Vous auriez ceci en stock ?
J'ai fait quelques recherches sans succès et j'ai même essayer de passer par nos amis les IA pour coder cette routine mais ça n'a jamais fonctionné ...

Merci à tous pour l'aide !

J'ai déjà vu ce genre de demande sans réponse finale donc je relance..

Je n'ai pas d'outil pour recadrer des PDF imprimés et je souhaiterais créer un lisp pour ajuster taille du papier à ma fenêtre d'impression.

Je m'y connais peu voire pas du tout en codage lisp, est-ce réalisable ? 

Sinon un lisp pour créer une configuration d'impression à la taille de ma fenêtre de sélection me suffirait !? 

Je vous remercie pour votre aide,

Maÿllis

Existe-t-il une Lisp équivalente à RB de Patrick_35, mais qui au lieu de placer tous les éléments de tous les blocs du dessin en Calque 0 - Dubloc, agirait seulement sur les blocs sélectionnés.

De plus si cette Lisp fonctionne sur AutoCAD LT, ce serait fantastique.

Merci d'avance à ceux qui voudront bien m'aider,

OliV

Dans une routine assez imposante de fusion d'un fichier natif dans un modèle pré-paramétré, je cherche à transformer l'apparence et la composition de certains "TEXT" en éléments "MTEXT" avec l'insertion de préfixes et suffixes composés de caractères unicodes , ◄ en préfixes et ► en suffixes.

Pour cela, j'ai adapté un morceau de LISP (PTX-STX) trouvé sur ce même forum, mais dans lequel je n'arrive pas à paramétrer les caractères UNICODE, même en les entrants manuellement.

(defun TextDp1b2Mtext (/ doc ent Pref Suff)
	(setq TDPsel (ssget "X" '((0 . "TEXT") (8 . "Sectionnement_PlotsAnno"))))
	(vl-load-com)
	(setq doc (vla-get-activedocument (vlax-get-acad-object)))
	(vla-startundomark doc)
	(setq Pref (getstring "\Entrer alt+17"))	;Définition du préfixe manuelle
  	(setq Suff (getstring "\Entrer alt+16"))	;Définition du suffixe manuelle
	(while (< i (sslength TDPsel))
		(setq ent (vlax-ename->vla-object (ssname TDPsel i)))
		(vla-put-textstring ent (strcat Pref (vla-get-textstring ent) Suff))
		(setq i (1+ i))
	)
	(vla-endundomark doc)
	(setq Setlen (sslength TDPsel) Count 0 )
	(repeat SetLen				
		(setq Ntxt (ssname TDPsel Count))
		(command "_txt2mtxt" Ntxt "")
		(setq jsF (ssadd (entlast))	NMtxt (entlast))
		(setq dxf_ent (entget NMtxt))
		(entmod 
			(append dxf_ent 
				(list 
					(cons 90 19)				;Encadrement
					(cons 8 "G-ANNOTATIONS")	;Calque
					(cons 40 0.15)				;Hauteur de texte
					(cons 45 1.2)				;Bordure
					(cons 441 0)				;Echelle
					(cons 41 1.4)				;Largeur
				)
			)
		)
		(setq Count (+ 1 Count))
	)
	(princ)
)

Le résultat du code joint me donne bien l'apparence désirée mais n'insère pas les caractères demandés.

Help me please.

J'ai un Lisp permettant de créer des talus qui fonctionnait bien jusqu'à lors. 

c'est depuis que je suis passé sur AutoCAD 2022 que j'ai un retour d'erreur après la sélection du 2eme point :

; erreur: une exception s'est produite: 0xC0000005 (Violation d'accès)
; avertissement: fonction unwind ignorée exception
; erreur: une exception s'est produite: 0xC0000005 (Violation d'accès)

Je ne sais plus ou j'ai trouvé ce Lisp

je mets en pj les fichiers...

talus.dcl talus.lsp talus.slb

Cela fait un moment que je n'ai pas posé de question sur ce forum, mais je suis bloqué sur un problème et j'aimerais obtenir des conseils.

Je cherche à insérer un bloc comportant plusieurs attributs dans AutoCAD, en affectant leurs valeurs directement depuis une feuille Excel.

Actuellement, j'ai une version fonctionnelle qui affecte les propriétés au dernier bloc inséré, et les attributs récupèrent et compilent ces propriétés. Cependant, le temps d'exécution est assez long, et j'aimerais optimiser ce processus (voir code ci-dessous).

Mon objectif serait de sauter l'étape intermédiaire des propriétés et d'intégrer directement les attributs dans le bloc. Il me semblait qu'avec Entmake, Attdef et Attrib, c'était plus rapide et relativement simple, mais je n'arrive pas à comprendre leur fonctionnement.

En parcourant le code Edit_bloc3.5 de (gile), j'ai l'impression d'être encore plus perdu qu'au départ.

Auriez-vous des suggestions pour optimiser le temps d'exécution et simplifier ce processus ?

Merci d'avance pour votre aide !

Dans le cadre d'un travail sur une nuage de points, j'ai créé plusieurs objets de coupe (section) et je souhaiterais par l'intermédiaire d'un ou plusieurs lisp en sectionner un afin de pouvoir changer la hauteur ou l'épaisseur plus facilement.

Ces objets de coupe son nommés VP, C1, C2, C3.... si besoin.

J'ai un lisp qui ne fonctionne uniquement qu'avec un seul objet de coupe, donc si quelqu'un peut me fournir un lisp qui fonctionne à partir du nom de l'objet.

Merci à ceux qui voudrons bien m'aider,

Cyril

Mes meilleurs voeux pour cette nouvelle année.

Je débute en lisp et je suis bloqué.

J'ai des blocs avec comme nom "DREF_INC_DOWN" et avec un attribut "REF_0A".

Je voudrai quand il trouve ce bloc, qu'il lise le champ "REF_01" et si il trouve dans la chaine de caractère de cet attribut "SF6" il doit remplacer par "GAS"

Voici le début de ma routine:

(setvar "cmdecho"    1)        ;;; voir le défilement des commandes
;(setvar "cmdecho"    0)        ;;; supprimer le défilement des commandes
(setvar "SECURELOAD"    0)        ;;; voir le défilement des commandes
;;; -----------------------------------------
;;; Fonction principale
;;; 

(defun  C:SF6()

      (graphscr)                        ;;; bascule sur l'éditeur GRAPHIQUE...

      (lire_attrib)
    
    
    
    
    
    
    
    
    (princ)
);defun  C:SF6

    (graphscr)                    ;;; bascule sur l'éditeur graphique
    
;;; -----------------------------------------
;;; Fonction secondaire
;;;
(princ)
;;; ----------------------------------
;;;  lire les données du cartouche
;;;
(defun  lire_attrib()
    
    ;;; nom bloc cartouche =   DREF_INC_DOWN / DREF_INC_UP / DREF_INC_RIGHT / DREF_INC_LEFT
    ;;;(setq    ENTALL        (ssget "X"    '( (0 . "INSERT") (and (2 . "DREF_INC_DOWN" ) (2 . "DREF_INC_UP" ) (2 . "DREF_INC_RIGHT" ) (2 . "DREF_INC_LEFT" ) ) ) )
     (setq    ENTALL        (ssget "X"    '( (0 . "INSERT") (2 . "DREF_INC_DOWN" ) ) )
        NOMBLOC     (ssname    ENTALL    0)
        NUM        0
    );setq

      ;;; ---------------------------------------
      ;;; récupère le NOM du bloc DYNAMIQUE

    (setq    NOMBLDYN    (vla-get-EffectiveName    (vlax-ename->vla-object NOMBLOC)    )     );setq
      
      (while    NOMBLOC
          ;;; ---------------------------------------
          ;;; récupère le N° ENTITE (bloc)
          (setq    NOMBLOC    (entnext    NOMBLOC) )

          ;;; ---------------------------------------
          ;;; récupère le TYPE D'ENTITE
          (if    NOMBLOC
            (setq    VERIFATT    (cdr    (assoc 0 (entget NOMBLOC ) ) )     );setq
        );if

        ;;; ---------------------------------------
          ;;; TESTE si arrive à la fin des ATTRIBUTS)
          (if    (=    VERIFATT    "SEQEND")
            (setq    NOMBLOC    nil)
        );if
      
          ;;; -------------------------------------------
          ;;; Affiche la liste des étiquettes d'ATTRIBUTS

          (if    NOMBLOC
            (setq    ETIQUETTE    (cdr    (assoc 2 (entget NOMBLOC ) ) )
                VALATT        (cdr    (assoc 1 (entget NOMBLOC ) ) )
            );setq
        );if

        (if    (=    ETIQUETTE    "REF_01")
              (setq    RENV    VALATT)
              ;;;;(atoi    RENV)
              ;;;;(if    (=    RENV    (WCMATCH    "RENV"    "*SF6*"))
              (subst "GAZ" "SF6" RENV)
              ;;;;);if
        );if

           (setq    NUM    (+    NUM    1) )
      
    );while
  
(princ)
);defun lire_attrib

Merci pour vos retours 🙂

J'utilise régulièrement une routine qui fonctionne très bien permettant de mettre 2 cotations (horizontal et vertical) selon 2 points 

Voilà la routine :

(defun c:T2 ()
  (setq pt1 (getpoint "\nSelectionnez le premier point de cote : "))  
  (setq pt2 (getpoint "\nSelectionnez le second point de cote : "))  

  (if pt1
    (progn
      ; Demander à l'utilisateur où placer la cote horizontale
      (setq pt3 (getpoint "\nSelectionnez le point de position de la cote horizontale : "))
      ; Placer la cote horizontale
      (command "COTLIN" pt1 pt2 "h" pt3)

      ; Demander à l'utilisateur où placer la cote verticale
      (setq pt4 (getpoint "\nSelectionnez le point de position de la cote verticale: "))
      ; Placer la cote verticale
      (command "COTLIN" pt1 pt2 "v" pt4)
    )
    (princ "\nOpération annulée.")
  )
  (princ)
)

Je souhaite y apporter une amélioration permettant de visualiser sur l'écran la position de la cotation 

L'idée est contourner le problème en évitant de présélectionner les pts 3 et 4 

(defun c:T2 ()
  (setq pt1 (getpoint "\nSelectionnez le premier point de cote : "))  ; Demande le premier point
  (setq pt2 (getpoint "\nSelectionnez le second point de cote : "))   ; Demande le second point

(command "COTLIN" pt1 pt2 "H") 
; Cliquer sur l'écran pour positionner le cote horizontal

; Relancer la commande pour la cotation veticale
;(command "COTLIN" pt1 pt2 "V" )
; Cliquer sur l'écran pour positionner le cote veticale

)

je joins un fichier dwg pour faire les test

test.dwg

Salut, Voici ma Lisp qui me fait gagner un temps fou . N'hésiter pas à me faire des retours ou idées d'amélioration.

1.               Présentation de la routine LISP d'aplomb et balade entre les étages : - PAN PAN

Cette routine permet de définir un écart personnalisé correspondant à la distance entre les étages, rendant vos opérations d'aplomb précises et rapides. C'est un outil très pratique pour les plombages et pour gérer efficacement des plans multi-niveaux. En gros elle fait des Pan, Copies et Déplacements incrémentés.

Cette LISP fonctionne aussi sur Autocad  LT.

2.               Intérêt de la routine

• Navigation fluide entre les étages : Utilisez les commandes 'BBB' et 'HHH' pour passer rapidement d'un étage à l'autre sans effort.
• Copie et déplacement précis : Les commandes 'HH', 'BB', 'DH', et 'DB' permettent de copier ou déplacer des éléments avec une grande précision.
• Cohérence dans la disposition des étages : Grâce à un écart prédéfini, ça assure l'aplomb entre les étages dans votre plan.
• Flexibilité d'inversion : Appuyez sur 'I' ou 'N' pour inverser facilement la direction (haut/bas) pendant vos opérations.
• Facilite les Présentations : Copier une fenêtre/présentation, faite 'HHH' dans la fenêtre et vous avez l'étage du dessus d'aplomb avec la disposition de la présentation précédente.

3.               Prérequis

Avant de commencer, assurez-vous de :

• Disposer vos étages aligné avec un écart constant entre chaque étages et de préférence un chiffre rond (par exemple : RDC à x0 y0, R+1 à x0 y10, R+2 à x0 y20).
• Définir l'écart (incrément) entre les étages en utilisant la commande 'EE' avant d'utiliser les autres fonctions.

4.               Utilisation

Voici comment tirer parti de cette routine :

• EE : Configurez l'écart (incrément) en spécifiant deux points ( de Bas en Haut) correspondant à la distance entre deux étages consécutifs. Mettez un écart rond pour plus de précision et de facilité.
• BBB/HHH : Naviguez vers l'étage supérieur ou inférieur.
• HH/BB : Copiez la sélection d'aplomb sur l'étage supérieur ou inférieur.
• DH/DB : Déplacez la sélection d'aplomb sur l'étage supérieur ou inférieur.

5.               Exemple pratique :

• Faites une ligne représentant votre décalage entre étages (par exemple, une ligne verticale de 10 de longueur )
• Utilisez 'EE' pour définir l'écart (incrément) entre le RdC et le R+1 avec les 2 extrémités de la ligne précédente (par exemple, 10 unités en Y ).
• Sélectionnez les objets à copier du RdC au R+1.
• Utilisez 'HH' pour copier d'aplomb vers le haut, répétez (Espace ou Entrer) pour copier au R+2, ou entrez 'I' ou 'N' pour inverser et copier d'aplomb vers le bas au Sous-Sol.

6.               Conseils et astuces

• Configurez des raccourcis clavier (exemple : boutons précédent/suivant de la souris) pour accéder rapidement aux commandes fréquentes, comme ^c^cHHH pour monter d'un étage.
• Créez des boutons sur la palette d'outils pour un accès rapide aux commandes.
• N’oubliez pas que vous pouvez inverser la direction ( 'I' ou 'N') pour alterner facilement entre les copies/déplacements vers le haut et vers le bas.
• Peut aussi servir pour des déplacements/copies rapide dans une légende, tableau ou n'importe quel paterne régulier.
• Très utile pour avoir des présentations qui plombent d'un étage à l'autre.

Cette routine LISP est là pour faciliter les plans multi-étages, c'est une méthode rapide et précise pour naviguer, présenter et manipuler les éléments entre les différents niveaux.

Profitez-en !

Bonne journée.

;; Raccourcis clavier ==> ^c^cHHH
;; Raccourcis clavier ==> ^c^cBBB

;; Code AutoLISP pour gérer le décalage en X et en Y et effectuer des opérations de panoramique
;; Code AutoLISP original avec ajout des commandes HH, BB, DH, et DB avec fonctionnalité de répétition
;; Commande EE pour configurer l'écart en X et Y en spécifiant deux points
(defun c:ee ()
  ;; Demander à l'utilisateur de spécifier deux points
  (setq pt1 (getpoint "\nSpécifiez le premier point: "))
  (setq pt2 (getpoint "\nSpécifiez le second point: "))

  ;; Calculer la distance entre les deux points
  (setq dx (- (car pt2) (car pt1)))
  (setq dy (- (cadr pt2) (cadr pt1)))

  ;; Stocker les valeurs de décalage dans des variables d'environnement
  (setenv "EcartX" (rtos dx 2 9))
  (setenv "EcartY" (rtos dy 2 9))

  ;; Afficher les valeurs de décalage
  (princ (strcat "\nEcart en X défini à: " (rtos dx 2 9)))
  (princ (strcat "\nEcart en Y défini à: " (rtos dy 2 9)))

  ;; Message explicatif
  (princ "\nL'écart a été configuré avec succès.")
  (princ "\nUtilisez les commandes 'BBB', 'HHH', 'HH', 'BB', 'DH', et 'DB' pour naviguer, copier et déplacer en utilisant ces écarts.")
  (princ)
)

;; Commande pour effectuer un PAN vers le bas avec les valeurs de décalage en X et Y
(defun c:bbb ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer des valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Exécuter la commande PAN avec les valeurs de décalage en X et Y
  (command "_.pan" "0,0" (strcat "@" ecartX "," ecartY))
  (princ)
)

;; Commande pour effectuer un PAN vers le haut avec les valeurs de décalage négatives
(defun c:hhh ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer des valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Calculer les valeurs de décalage négatives
  (setq ecartX-neg (rtos (- (atof ecartX)) 2 9))
  (setq ecartY-neg (rtos (- (atof ecartY)) 2 9))

  ;; Exécuter la commande PAN avec les valeurs de décalage négatives
  (command "_.pan" "0,0" (strcat "@" ecartX-neg "," ecartY-neg))
  (princ)
)

;; Commande HH (Copie Haut)
(defun c:hh ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer les valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Vérifier s'il y a une sélection active
  (setq sel (ssget))
  (if sel
    (progn
      (setq multiplier-up 1)
      (setq multiplier-down 1)
      (setq direction 1)
      (setq first-inversion T)
      (while T
        (setq current-multiplier (if (> direction 0) multiplier-up multiplier-down))
        (setq vector (strcat "@" (rtos (* (atof ecartX) direction current-multiplier) 2 9) "," (rtos (* (atof ecartY) direction current-multiplier) 2 9)))
        (command "_.COPY" sel "" "0,0" vector)
        (princ (strcat "\nCopie effectuée: " vector))
        (initget "Inverser Nouveau Quitter")
        (setq input (getkword "\nAppuyez sur Entrée pour continuer, tapez [I]nverser, [N]ouveau ou [Q]uitter: "))
        (cond
          ((= input "Quitter") (exit))
          ((or (= input "Inverser") (= input "Nouveau"))
           (setq direction (* direction -1))
           (if first-inversion
             (setq first-inversion nil)
             (if (> direction 0)
               (setq multiplier-up (1+ multiplier-up))
               (setq multiplier-down (1+ multiplier-down))
             )
           )
          )
          (T 
           (if (> direction 0)
             (setq multiplier-up (1+ multiplier-up))
             (setq multiplier-down (1+ multiplier-down))
           )
          )
        )
      )
    )
    (princ "\nAucune sélection n'a été faite.")
  )
  (princ)
)

;; Commande BB (Copie Bas)
(defun c:bb ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer les valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Vérifier s'il y a une sélection active
  (setq sel (ssget))
  (if sel
    (progn
      (setq multiplier-up 1)
      (setq multiplier-down 1)
      (setq direction -1)
      (setq first-inversion T)
      (while T
        (setq current-multiplier (if (> direction 0) multiplier-up multiplier-down))
        (setq vector (strcat "@" (rtos (* (atof ecartX) direction current-multiplier) 2 9) "," (rtos (* (atof ecartY) direction current-multiplier) 2 9)))
        (command "_.COPY" sel "" "0,0" vector)
        (princ (strcat "\nCopie effectuée: " vector))
        (initget "Inverser Nouveau Quitter")
        (setq input (getkword "\nAppuyez sur Entrée pour continuer, tapez [I]nverser, [N]ouveau ou [Q]uitter: "))
        (cond
          ((= input "Quitter") (exit))
          ((or (= input "Inverser") (= input "Nouveau"))
           (setq direction (* direction -1))
           (if first-inversion
             (setq first-inversion nil)
             (if (> direction 0)
               (setq multiplier-up (1+ multiplier-up))
               (setq multiplier-down (1+ multiplier-down))
             )
           )
          )
          (T 
           (if (> direction 0)
             (setq multiplier-up (1+ multiplier-up))
             (setq multiplier-down (1+ multiplier-down))
           )
          )
        )
      )
    )
    (princ "\nAucune sélection n'a été faite.")
  )
  (princ)
)

;; Commande DH (Déplacement Haut)
(defun c:dh ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer les valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Vérifier s'il y a une sélection active
  (setq sel (ssget))
  (if sel
    (progn
      (setq direction 1)
      (while T
        (setq vector (strcat "@" (rtos (* (atof ecartX) direction) 2 9) "," (rtos (* (atof ecartY) direction) 2 9)))
        (command "_.MOVE" sel "" "0,0" vector)
        (princ (strcat "\nDéplacement effectué: " vector))
        (initget "Inverser Nouveau Quitter")
        (setq input (getkword "\nAppuyez sur Entrée pour continuer, tapez [I]nverser, [N]ouveau ou [Q]uitter: "))
        (cond
          ((= input "Quitter") (exit))
          ((or (= input "Inverser") (= input "Nouveau")) (setq direction (* direction -1)))
        )
      )
    )
    (princ "\nAucune sélection n'a été faite.")
  )
  (princ)
)

;; Commande DB (Déplacement Bas)
(defun c:db ()
  ;; Récupérer les valeurs des variables de dessin "EcartX" et "EcartY"
  (setq ecartX (getenv "EcartX"))
  (setq ecartY (getenv "EcartY"))

  ;; Si les variables ne sont pas définies, demander à l'utilisateur d'entrer les valeurs
  (if (not ecartX)
    (setq ecartX (getreal "\nEntrez la valeur pour Ecart en X: "))
  )
  (if (not ecartY)
    (setq ecartY (getreal "\nEntrez la valeur pour Ecart en Y: "))
  )

  ;; Vérifier s'il y a une sélection active
  (setq sel (ssget))
  (if sel
    (progn
      (setq direction -1)
      (while T
        (setq vector (strcat "@" (rtos (* (atof ecartX) direction) 2 9) "," (rtos (* (atof ecartY) direction) 2 9)))
        (command "_.MOVE" sel "" "0,0" vector)
        (princ (strcat "\nDéplacement effectué: " vector))
        (initget "Inverser Nouveau Quitter")
        (setq input (getkword "\nAppuyez sur Entrée pour continuer, tapez [I]nverser, [N]ouveau ou [Q]uitter: "))
        (cond
          ((= input "Quitter") (exit))
          ((or (= input "Inverser") (= input "Nouveau")) (setq direction (* direction -1)))
        )
      )
    )
    (princ "\nAucune sélection n'a été faite.")
  )
  (princ)
)

;; Afficher un message pour indiquer que les fonctions ont été chargées
(princ "\n
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Les commandes suivantes sont disponibles :")
(princ "\n 1. 'EE'  - Configurer l'écart en spécifiant deux points (de Bas en Haut).")
(princ "\n 2. 'BBB' - Effectuer un panoramique vers le Bas.")
(princ "\n 3. 'HHH' - Effectuer un panoramique vers le Haut.")
(princ "\n 4. 'HH'  - Copier la sélection vers le Haut (copies multiples possibles, tapez 'I' ou 'N' pour inverser).")
(princ "\n 5. 'BB'  - Copier la sélection vers le Bas (copies multiples possibles, tapez 'I' ou 'N' pour inverser).")
(princ "\n 6. 'DH'  - Déplacer la sélection vers le Haut (déplacements multiples possibles, tapez 'I' ou 'N' pour inverser).")
(princ "\n 7. 'DB'  - Déplacer la sélection vers le Bas (déplacements multiples possibles, tapez 'I' ou 'N' pour inverser).")
(princ "\n 
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Pour configurer des Raccourcis Clavier pour les Pan dans tes Commandes Personalisée
      ==> ^c^cHHH & ^c^cBBB
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -")
	  
(princ)

- PanPan.lsp

je suis régulièrement amené à replacer la position de 2 attributs affichés sur une grande quantité de mes blocs, en fonction des objets présents autour.

Je faisait jusqu'à présent clic bloc > clic poignée attribut 1 > placement > clic poignée attribut 2 > placement. 5 clics * jusqu'à 150 blocs.

Je voulais un lisp pour réduire ça à 2 clics.

Je me débrouille pas trop mal en lisp, mais n'ai pas trouvé de solution pour accéder au point d'insertion de ces attributs(est-ce possible ?), j'ai donc dû passer par du visual lisp, dans lequel je ne connais pas grand chose, et que j'utilise peu.

Pour se faire, j'ai récupéré un vieux lisp de @(gile), (que je remercie chaleureusement, (ainsi que pour son "Introduction à AutoLISP" (qui est devenu mon livre de chevet))), que j'ai re-bricolé à ma sauce.

Tout marche comme je le veut, à une exception : je dois placer le texte à l'aveugle, en faisant un clic dans le vide parfois entre des objets serrés. J'aimerais que le texte s'affiche sous mon curseur avant que je clique, comme quand j'utilisais la poignée.

J'espère ne pas avoir été trop rébarbatif, et vous souhaite une bonne journée.

; désolé pour la quantité de commentaires, j'en ai besoin pour comprendre un code difficile pour moi.

déplacement att points.lsp

j'essaie de réaliser un lisp pour qu'il puisse me générer le milieu entre deux polylignes 3D qui n'ont pas le même nombre de sommets;

ca donne ca:
 

Citation

(defun c:UniformiserSommets ( / pl1 pl2 points1 points2 nb-points1 nb-points2 nb-max interpol-points1 interpol-points2 i step)
  ;; Fonction pour récupérer les sommets d'une polyligne
  (defun GetPolylinePoints (pl)
    (setq points nil)
    (if (and (vlax-property-available-p pl 'Coordinates)
             (setq coords (vlax-get pl 'Coordinates)))
      (progn
        (repeat (/ (length coords) 3)
          (setq points (append points (list (list (car coords) (cadr coords) (caddr coords)))))
          (setq coords (cdddr coords))
        )
      )
    )
    points
  )

  ;; Fonction pour interpoler des points sur une polyligne
  (defun InterpolatePolylinePoints (points nb-new-points)
    (if (and points (> (length points) 1))
      (let ((segments (1- (length points)))
            interpolated nil
            step (/ (float segments) (1- nb-new-points)))
        (setq i 0.0)
        (repeat nb-new-points
          (let* ((seg-index (fix i))
                 (t (- i seg-index))
                 (p1 (nth seg-index points))
                 (p2 (nth (1+ seg-index) points))
                 (interp-point (mapcar '(lambda (a b) (+ a (* t (- b a)))) p1 p2)))
            (setq interpolated (append interpolated (list interp-point))))
          (setq i (+ i step)))
        interpolated
      )
    )
  )

  ;; Sélection des deux polylignes
  (if (and (setq pl1 (car (entsel "\nSélectionnez la première polyligne 3D : ")))
           (setq pl2 (car (entsel "\nSélectionnez la deuxième polyligne 3D : "))))
    (progn
      ;; Conversion en objets VLA
      (setq pl1 (vlax-ename->vla-object pl1)
            pl2 (vlax-ename->vla-object pl2))
      
      ;; Vérification des types
      (if (and (eq (vla-get-ObjectName pl1) "AcDb3dPolyline")
               (eq (vla-get-ObjectName pl2) "AcDb3dPolyline"))
        (progn
          ;; Récupération des points
          (setq points1 (GetPolylinePoints pl1)
                points2 (GetPolylinePoints pl2)
                nb-points1 (length points1)
                nb-points2 (length points2))
          
          ;; Déterminer le nombre maximal de points
          (setq nb-max (max nb-points1 nb-points2))
          
          ;; Interpolation des points pour chaque polyligne
          (setq interpol-points1 (InterpolatePolylinePoints points1 nb-max)
                interpol-points2 (InterpolatePolylinePoints points2 nb-max))
          
          ;; Mise à jour des polylignes
          (if interpol-points1
            (progn
              ;; Mise à jour de la première polyligne
              (vla-put-Coordinates pl1
                                   (vlax-make-safearray
                                     vlax-vbDouble
                                     (cons 0 (1- (* 3 nb-max)))))
              (vla-put-Coordinates pl1
                                   (apply 'append interpol-points1))
            )
          )
          (if interpol-points2
            (progn
              ;; Mise à jour de la deuxième polyligne
              (vla-put-Coordinates pl2
                                   (vlax-make-safearray
                                     vlax-vbDouble
                                     (cons 0 (1- (* 3 nb-max)))))
              (vla-put-Coordinates pl2
                                   (apply 'append interpol-points2))
            )
          )
          (princ "\nLes deux polylignes ont maintenant le même nombre de sommets.")
        )
        (princ "\nLes entités sélectionnées ne sont pas des polylignes 3D.")
      )
    )
    (princ "\nOpération annulée.")
  )
  (princ)
)
 

mais je ne comprends pas mon erreur

Pouvez-vous m'aider ?

Merci

Je suis débutant en lisp et je n'arrive pas à construire ma routine qui me permettrait de supprimer l'ensemble des xref d'un dessin.

Peut importe leurs états : chargés, déchargés, introuvables, etc.

Pour être le plus complet possible. J'aimerais que mon code puisse supprimer tout les xref qu'elles qu'ils soient : dwg / image / dwf / dgn / pdf

J'avais commencé à construire le code ci-dessous, mais ça ne marche pas. (erreur : " ; erreur: type d'argument incorrect: VLA-OBJECT nil ")

       (vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
                 (or (eq (vla-get-isxref bl) :vlax-false)
                   (findfile (vla-get-path bl))
                   (vla-detach bl)

Je sèche un peu quelqu'un, aurait-il des suggestions ?

Je vous remercie tous d'avance.

Je travail beaucoup avec les ETAT de CALQUE que j'applique sur les fenêtres.

Je cherche un moyen d'appliquer un état de calque sur une fenêtre sélectionnait préalablement sans activer la fenêtre (le double clic)

voilà ce que j'ai déjà écrit mais on est très loin de ce dont je recherche, pire encore, les 2 routines s'applique sur les toutes les fenêtres.

(defun c:APPE ()
(layerstate-restore "ETAT02" viewportId 5)
)


(defun c:APPE2 ()
(command "-CALQUE" "A" "R" "ETAT02" "" "")
)

Vous avez compris que je suis nul en écriture de routine.

je joins un fichier dwg pour tester la routine

Si quelqu'un veut bien m'aider s'ils vous plait 

APPE.lsp Test.dwg

j'ai des hachures qui ne sont pas associatives.

pour les étirer il faut sélectionner tous les grips voulu un par un.

avez vous une routine qui sélectionnerai tous les grips d'une hachure a l’intérieur d'une polyligne préalablement dessiner ou pas.

une fois les grips de l'hachure passer en "rouge"  suffirait de l'etirer suivant un grip.

je viens de récupérer un fichier *.dwg avec des blocs en 2D dans lesquels il y a des entités avec des Z ( non égal a 0.0) qui parfois bien sur ne sont pas en Z = 0.0.

auriez vous un lisp pour remettre toutes les entites d'un bloc avec un Z=0 ( en sélectionnant plusieurs blocs a la fois, qui peut le plus peu le moins )

sans etre obligé de les ouvrir un par un et de faire le lisp suivant

;;; tout en Z=ZERO
(defun c:z0 ()
  (setq osm (getvar "osmode"))
  (setq pic (getvar "pickstyle"))
  (setvar "osmode" 0)
  (prompt (strcat "\nCLIQUER SUR LES OBJETS A DEPLACER EN Z = ZERO : "))
  (setq obj nil)
  (while (null obj) (setq obj (ssget)))
  (setvar "osmode" osm)
  (setvar "PICKSTYLE" 0)
  (setvar "osmode" 0)
  (command-s "DEPLACER" obj "" "0,0,1e99" "0,0,-1e99")
  (command-s "DEPLACER" obj "" "0,0,-2e99" "0,0,0")
  (setvar "pickstyle" pic)
  (setvar "osmode" osm)
  (princ)
)

merci

Phil

J'ai ouvert un sujet ici

Utilisation du Lisp IXL de Patrick35 - AutoCAD 2014 - CadXP

Peut-être aurais-je dû commencer ici pour espérer avoir un retour...?

Gilles

avant de me lancer dans une programmation hasardeuse,

je vérifie  que ce dont j'ai besoin n'existe pas déjà.

Je reçois parfois de dwg où les entités de l'espace objet ont été dupliquées 20 fois, en fonction de ce que le dessinateur voulait représenter, ou conserver "au cas ou" etc ...

Comment savoir quelle partie de l'espace objet correspond à quoi ?

le lisp dont j'ai besoins doit parcourir les onglets de présentation, parcourir les fenêtres, et tracer dans chaque fenêtre l'emprise de cette fenêtre avec un texte contenant le nom de la présentation (ou alors tracer les emprises dans un calque ayant le nom de la présentation)

si ça existe déjà, je prends ...

a+

Gégé

TOUT est dans le titre !

Cela est facile avec MicroStation ! ... Et donc comment faire VITE sous AutoCAD ??

J'aimerais montrer un segment ou arc (eventuellement de Polyligne)

montrer un AUTRE segment ou arc (eventuellement de Polyligne)

et monter un point precis (avec accrochage si possible)

L'ordre des parametres n'a pas d'importance !

MERCI de vos lumieres, Bye, lecrabe

Est-ce que quelqu'un peut m'écrire une routine qui ressemble à un "copier les propriétés" mais pour une valeur d'un texte.

Je m'explique (voir image) :

La routine 1 (que j'ai déjà) : permettant de cumuler les surface de plusieurs texte.

La routine 2 permettant de de :
1) Sélectionner le texte 61.19 pour copier la valeur
2) Sélectionner le texte 60.00 pour coller la nouvelle valeur
3) Effacer le texte d'origine 1ère sélection 

à première vu, cela ne semble pas très utile mais dans mon quotidien cela me permettrait de réduire considérablement le nombre de manœuvre

Je joins également le fichier dwg 

en vous remerciant par avance 

Test.dwg