Lisp pour Encartage

[quentinQS]

Bonjours

Voici mon souci j'ai mon mon encartage en espace objet, j'aimerais transformé tout mon encartage en présentation, mais en utilisant le même cartouche sur chaque présentation

Il y a t'il un Lisp pour cela

J'en avait un mais il ne fonctionne pas

 

Le Voici

 

 

;;;Fonctionnement :

 

;;;- Les cadres de pages doivent être des blocs.

 

;;;(Si vous avez des cadres en simple rectangle, transformez en un en bloc et faites un réseau ou un copier)

 

;;;- Afin d'éviter toutes erreur, une présentation déjà paramétré doit exister (Une fenêtre de présentation cadré et mis à l'échelle, Traceur, échelle de tracé pour un cadre).

 

;;;- Les cadres en Espace Objets peuvent être à n'importe quel échelle, et peuvent être mélangé Portrait et Paysage.

 

;;;- L'unité d'insertion doit être en millimètre, centimètre ou mètre.

 

;;;- Le nom des onglet sera incrémenter de +1.

 

 

;;;- Commande : CEP

 

 

; Crée un onglet EP par cadre (bloc) de page sélectionné en EO

 

; par Bred - Un onglet déjà paramétrer doit exister

 

(defun c:CEP (/ ACDOC B C FEN I LAYS N-P NOM-P ONG-BASE ONG_DEST SEL XMIN YMAX

 

A-P HAUT LARG P1 P2 NOM ECH LAY LOCK UNIT)

 

(vl-load-com)

 

; 4 Millimètres 5 Centimètres 6 Mètres

 

(setq Unit (cdr (assoc (getvar "INSUNITS") '((4 . 1) (5 . 10) (6 . 1000)))))

 

(while (not sel)

 

(setq sel (car (entsel "\n Choix du cadre (Bloc) :")))

 

(if sel

 

(if (not (equal (vla-get-ObjectName (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))

 

(setq sel nil)))

 

)

 

(setq sel (ssget '((0 . "INSERT")))

 

AcDoc (vla-get-activedocument (vlax-get-acad-object))

 

nom-p (getstring t "\n Nom des Onglets à Créer :")

 

layS (layoutlist))

 

 

(if (> (length layS) 1)

 

(progn

 

(princ "\n Copie configuration traceur d'onglet Existant. \n Plusieurs Présentations détectées.")

 

(while (not ong-base)

 

(princ "\n")

 

(repeat (setq i (length layS))

 

(princ (strcat (nth (- (length layS) i) layS) " * "))

 

(setq i (1- i)))

 

(setq ong-base (getstring t "\n Présentation d'où la configuration du traceur sera récupérée :"))

 

(if (not (member ong-base layS))

 

(setq ong-base nil))))

 

(setq ong-base (car layS)))

 

 

(setq a-p (vla-item (vla-get-layouts AcDoc) ong-base))

 

(vla-getcustomscale a-p 'n 'm)

 

 

 

(vla-put-ActiveLayout AcDoc a-p)

 

(vlax-for e (vla-get-paperspace AcDoc)

 

(if (equal (vla-get-ObjectName e) "AcDbViewport")

 

(setq lay (vla-get-Layer e)

 

lock (vla-get-DisplayLocked e)))

 

)

 

 

(setq i 0)

 

(repeat (sslength sel)

 

(if (vlax-property-available-p (vlax-ename->vla-object (ssname sel i)) 'effectivename)

 

(setq nom vla-get-effectivename)

 

(setq nom vla-get-name))

 

 

(if (equal (nom (setq c (vlax-ename->vla-object (ssname sel i))))

 

(nom B))

 

(progn

 

(vla-GetBoundingBox c 'xmin 'ymax)

 

(setq n-p (vla-add (vla-get-Layouts AcDoc) (setq ong_dest (strcat nom-p " - " (rtos (1+ i) 2 0)))))

 

 

(setq ech (vla-get-XEffectiveScaleFactor c))

 

(vla-copyfrom n-p a-p)

 

(vla-put-ActiveLayout AcDoc n-p)

 

(setq fen

 

(vla-AddPViewport (vla-get-paperspace AcDoc) (vlax-3d-point '(0 0 0))

 

(setq Larg (* Unit (/ (- (car (vlax-safearray->list ymax)) (car (vlax-safearray->list xmin))) ech)))

 

(setq Haut (* Unit (/ (- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin))) ech)))))

 

(vla-put-Layer fen lay)

 

(vla-put-DisplayLocked fen lock)

 

(vla-ZoomExtents (vlax-get-acad-object))

 

(vla-Display fen :vlax-true)

 

(vla-put-MSpace AcDoc :vlax-true)

 

(vla-put-ActivePViewport AcDoc fen)

 

(vla-ZoomWindow (vlax-get-acad-object) xmin ymax)

 

(vla-put-MSpace AcDoc :vlax-false)

 

(if (> (- (car (vlax-safearray->list ymax)) (car (vlax-safearray->list xmin)))

 

(- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin))))

 

(vla-put-PlotRotation (vla-get-activelayout AcDoc) ac90degrees)

 

(vla-put-PlotRotation (vla-get-activelayout AcDoc) ac0degrees))

 

(setq p1 (vlax-make-safearray vlax-vbdouble (cons 0 1))

 

p2 (vlax-make-safearray vlax-vbdouble (cons 0 1)))

 

(vlax-make-variant

 

(vlax-safearray-fill p1 (list (- (/ Larg 2)) (- (/ Haut 2)))))

 

(vlax-make-variant

 

(vlax-safearray-fill p2 (list (/ Larg 2) (/ Haut 2))))

 

(vla-put-PlotType (vla-get-activelayout AcDoc) acWindow)

 

(vla-setwindowtoplot (vla-get-activelayout AcDoc) p1 p2)

 

(setq i (1+ i))

 

) ) )

 

(setvar "TILEMODE" 1)

 

(princ)

 

)

 

 

 

En pièce jointe une vue de l'encartage

Merci d'avance pour vos réponse

[lili2006]

Bonjour à toutes et tous,

As tu vu ce post récent ? => https://cadxp.com/topic/25055-presentations-multiples-automatisation/page__p__136274#entry136274

 

[quentinQS]

Merci j'ai utilisé le Lisp propose mais ca ne fonctionne pas !

[Invité sbb]

Bonjour , je cherche désespérément le moyen de créer des présentations automatiquement en rapport avec les rectangles (bloc ) positionner dans l' espace objet

pouvez-vous m'aider ? ptet via un lisp ??

merci d'avance

[gistotocao]

Bonjour je relance le sujet

J'ai cherche une solution, je travaille sur Autocad map3d mais aucune connaissance en lisp.....

Je cherche désespérément le moyen de créer des présentations automatiquement en rapport avec les rectangles (bloc ) positionner dans l' espace objet

pouvez-vous m'aider ? ptet via un lisp ??

merci de votre aide