Presentations multiples : Automatisation

lili2006 · le 11 février 2021

Re,

Je viens d'essayer, cela ne change rien,..Sniff

Sélectionner des objets:
1 : JPG1188x1680
2 : PNG1188x1680
3 : JPG570x800
4 : A3H RDC 1-50 PL001-
5 : 00
SELECTIONNER LE TYPE DE CADRE A RECRER (1 2 3 4 5) :
Restauration des fenêtres enregistrées en mémoire cache - Régénération de la présentation.
; erreur: no function definition: GESTATTB
Commande:

Luna · le 11 février 2021

Je pense juste qu'il manque la définition de la fonction (getatt) utilisée par PHILPHIL dans sa commande.

Bisous,

Luna

PHILPHIL · le 11 février 2021

hello LILI

effectivement il manquait ca ( merci Gil )

;; GETATT
;; Retourne une liste d'association des attribut du bloc
;;
;; Argument
;; bl : la référence de bloc (ename ou vla-object)
;;
;; Retour
;; une liste d'association du type : ((etiquette . valeur) ...)

(defun getatt (bl)
 (vl-load-com)
 (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl)))
 (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true))
   (mapcar (function (lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x))))
           (vlax-invoke bl 'getattributes)
   )
 )
)

;; PUTATT
;; Donne les valeurs de la liste aux attributs du bloc
;;
;; Arguments
;; bl : la référence de bloc (ename ou vla-object)
;; lst : une liste d'association du type : ((etiquette . valeur) ...)
;;
;; Retour
;; une liste d'association du type des attributs traités

(defun putatt (bl lst / att ret)
 (vl-load-com)
 (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl)))
 (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true))
   (mapcar (function (lambda (x)
                       (if (setq att (assoc (vla-get-tagstring x) lst))
                         (progn (vla-put-textstring x (cdr att)) (setq ret (cons att ret)))
                       )
                     )
           )
           (vlax-invoke bl 'getattributes)
   )
 )
 ret
)

a+

Phil

lili2006 · le 11 février 2021

Re,

Super !

En effet, ça marche beaucoup mieux comme ça !!

Merci encore à toi !!

lili2006 · le 11 février 2021

Re,

Je viens de modifier le bloc de l'espace papier (attributs et états de visibilité) et celui_ci n'arrive pas dans les présentations créées !!

Une idée ?

Merci d'avance,

LE FICHIER TESTE

lili2006 · le 11 février 2021

Re,

En fait, il faudrait que je puisse utiliser ces deux BLOCS dans la routine CEP,..

PHILPHIL · le 11 février 2021

Hello LILI

je viens de passer "CEP" sur ton fichier et ca marche

et "CEP2" ca marche aussi

les derniers lisp que j'ai postés hier

tu as modifié les attributs OK

quand tu parles des "etats de visibilité" tu parle de quoi la ? car MON bloc ne comporte pas de parametre de "visibilité"

tu n'as rien changé dans le LISP par hazard ?

le fait d'etre en grades au lieux de dégrés ou d'etre en "horaire" plutot quand "trigonométrique", d'avoir un angle de base de "300g" au lieux de "0g" n'influence pas le LISP

a+

Phil

lili2006 · le 11 février 2021

Re,

quand tu parles des "etats de visibilité" tu parle de quoi la ? car MON bloc ne comporte pas de parametre de "visibilité"

Oui, j'ai modifié les deux blocs cf post précédents (nos posts ont du se croiser,...)

tu n'as rien changé dans le LISP par hazard ?

J'ai rajouté en fin de lisp la fonction "GETATT" de (gile)

lili2006 · le 11 février 2021

Le LISP que j'utilise donc,...

PHILPHIL · le 11 février 2021

hello LILI

deja il est normal que le bloc qui est implanté dans l'onglet papier "00" n'arrive pas dans les nouveaux onglet papier en utilisant le lisp CEP

le lisp "CEP" créer un onglet avec une nouvelle fenetre qui regarde l'espace papier en s'ajustant pile poil au bloc implanté dans l'espace papier

quand tu dis ca ne marche pas ? qu'est ce qui ne marche pas en fait ?

dans MON bloc "cadre image" : les parametres "hauteur de cadre" et "largeur de cadre" font varié le cadre bleu et et l'echelle des attributs

dans TON bloc "cadre image" issu de MON bloc, tu as rajouté en bas a droite "PLAN : N°" sur lequel aucun parametre de mise a l'échelle n'intervient !

( c'est ca que tu dis qui ne marche pas ?)

pour ce qui est du bloc implanté dans ton onglet "00" je l'ai recopie avec le lisp "CPP"

( copier des entitee d'un onglet sur d'autres onglets du fichier sans les ouvrir ) apres coup

petite remarque de puriste : ton bloc dans "00" meme dessiné en millimettre a des coordonnées avec des chiffres apres la virgule

lisp : "regular draw" permet de rectifier ca

j'avais du le faire dans le fichier que je t'avais renvoyé

a+

Phil

lili2006 · le 11 février 2021

Re,

Oui, en effet, c'est de mon ignorance que cela ne "fonctionne pas" comme je l'imagine et toutes tes questions sont les bonnes,..

dans MON bloc "cadre image" : les parametres "hauteur de cadre" et "largeur de cadre" font varié le cadre bleu et et l'echelle des attributs

Compris !

dans TON bloc "cadre image" issu de MON bloc, tu as rajouté en bas a droite "PLAN : N°" sur lequel aucun parametre de mise a l'échelle n'intervient !

( c'est ca que tu dis qui ne marche pas ?)

Vi (honte à moi !!)

pour ce qui est du bloc implanté dans ton onglet "00" je l'ai recopie avec le lisp "CPP"
( copier des entitee d'un onglet sur d'autres onglets du fichier sans les ouvrir ) apres coup

Connais pas,..

petite remarque de puriste : ton bloc dans "00" meme dessiné en millimettre a des coordonnées avec des chiffres apres la virgule

Ouh là, en effet, pas besoin de précision extrême,..

lisp : "regular draw" permet de rectifier ca

Connais pas non plus,..

Est ce que ça marche depuis chez toi avec ces nouveaux blocs ? Si oui, dans le doute, peux tu m'envoyer le lisp que tu utilises et le fichier STP ?

Je vais essayer de regarder ça demain, le truc, c'est que j'ai 5 autres projets de fin d'études aussi à préparer,..Le plus "tendu" pour moi, c'est celui ci car dans les mises en pages, les étudiants galère dur en général et ils auront bien assez de topo à faire comme ça,..Encore merci de ton investissement pour nos chères têtes blondes,..

lili2006 · le 12 février 2021

Bonjour à toutes et tous,

Salut PHILPHIL,

pour ce qui est du bloc implanté dans ton onglet "00" je l'ai recopie avec le lisp "CPP"
( copier des entitee d'un onglet sur d'autres onglets du fichier sans les ouvrir ) apres coup

Ah ok, je croyais qu'il se copiait également avec la routine,..

Peux tu me donner le lien de téléchargement de ce lisp CCP, STP ?

la difficulte est de jouer avec : l'echelle de l'espace OBJET
l'echelle de l'espace PAPIER
l'echelle du bloc implanté CADRE IMAGE
l'echelle dans laquelle le bloc a été dessinner

En effet, je n'ai pas encore réussit à trouver le facteur qui va bien,..

Normalement, au millième quand on est en m qans l'EO, on devrait avoir un rapport de 1 !!

1000 x 1/1000 =1

Te souviens tu comment tu avais fait au niveau des echelles sur l'exemple que tu a déposé sur le post 21 ?

Je vais continuer mes tests,..

Merci encore, je commence à mieux comprendre comment marche ce lisp,..

lecrabe · le 12 février 2021

Hello

Et voici la routine CPP de Bryce ...

En esperant que l'on parle bien de CETTE Routine !?

LA SANTE, Bye, lecrabe "fatigue"


;; 
;; http://cadxp.com/topic/44976-etat-des-calques-dune-fenetre-copiee/page__pid__261195#entry261195
;; 
 
;; 
;; BS:GETOTHERLAYOUTS Bryce 19/01/2012 
;; base sur GETLAYOUTS (gile) 03/12/07 
;;
;; Retourne la liste des Presentations choisies dans la boite de dialogue
;; La presentation active n'est pas proposee.
;;
;; arguments
;; titre : titre de la boite de dialogue ou nil, defauts = Choisir la (ou les) Presentation(s)
;; mult : T ou nil (pour choix multiple ou unique)
;; 

;; Routine: CPP - Bryce, janvier 2012
;; Copie les objets selectionnes dans les presentations choisies 

(vl-load-com)

(defun bs:GetOtherLayouts (titre mult / lay tmp file ret)
 (setq	lay  (vl-sort (vl-remove (getvar 'CTAB) (layoutlist))
	      (function
		(lambda	(x1 x2)
		  (< (TabOrder x1)
		     (TabOrder x2)
		  )
		)
	      )
     )
tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat
     "GetLayouts:dialog{label="
     (if titre
(vl-prin1-to-string titre)
(if mult
  "\"Choisir les presentations\""
  "\"Choisir une presentation\""
)
     )
     ";:list_box{key=\"lst\";multiple_select="
     (if mult
"true;}:row{:retirement_button{label=\"Toutes\";key=\"all\";}
ok_button;cancel_button;}}"
"false;}ok_cancel;}"
     )
   )
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "GetLayouts" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list lay)
 (end_list)
 (action_tile "all" "(setq ret (reverse lay)) (done_dialog)")
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
(foreach n (str2lst (get_tile \"lst\") \" \")
(setq ret (cons (nth (atoi n) lay) ret))))
(done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (reverse ret)
)

(defun TabOrder (name / dict lay)
; (gile)
 (setq dict (dictsearch (namedobjdict) "ACAD_LAYOUT"))
 (if (setq lay (cdr (assoc 350 (member (cons 3 name) dict))))
   (cdr (assoc 71 (entget lay)))
 )
)

(defun str2lst (str sep / pos)
; (gile)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
  (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

(defun bs:ss2safearray (sset / i entlst)
; Bryce
(setq i 0)
(repeat (sslength sset)
 (setq entlst (cons (vlax-ename->vla-object (ssname sset i)) entlst))
 (setq i (1+ i))
)
(vlax-safearray-fill
	(vlax-make-safearray vlax-vbObject (cons 0 (1- (length entlst))))
	entlst
)
)


(defun c:CPP (/ acdoc layouts selectedlayouts *error* lay ss sa) 

;; Routine: CPP - Bryce, janvier 2012
;; Copie les objets selectionnes dans les presentations choisies 

(setq	layouts (vla-get-layouts (setq
	acdoc (vla-get-ActiveDocument (vlax-get-acad-object))))
)

(defun *error* (msg)
(and msg
	(or
		(member (strcase msg) '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
		(princ (strcat "\nErreur : " msg))
	)
)
(if ss (setq ss nil))
(vla-endundomark acdoc)
(princ)
)

(vla-startundomark acdoc)

(or
(and
	(/= (getvar 'CTAB) "Model")
	(= (getvar 'CVPORT) 1)
)
(progn
	(princ "\n** Commande non autorisee dans l'espace Objet** ")
	(quit)
)
)

(if (and
	(or
		(setq ss (cadr (ssgetfirst)))
		(setq ss (ssget))
	)
	(setq sa (bs:ss2safearray ss))
)
(progn
	(setq selectedlayouts (bs:getotherlayouts nil T))
	(foreach lay selectedlayouts
		(vla-CopyObjects acdoc sa (vla-get-block (vla-item layouts lay)))
	); foreach
	(princ "\nCopie effectuee ! ")
)
);if ssget

(*error* nil)
);cpp


(princ "\nCommande a utiliser: CPP ")
(princ)

PHILPHIL · le 12 février 2021

hello LILI

je vient de retester CEP et CEP2

le fait de changer l'echelle implanté du bloc "IMAGE CADRE" ( en x=1 y=1 z=1) dans le fichier, peut faire que ca ne marche plus TRES BIEN.

ex : je voyais dans l'espace papier la fenetre objet,( 4.3x 2.9 ) et en zoomant arriere le cadre papier cent fois plus grand

ca devient une équation a X inconnues

echelle du bloc

echelle du bloc implanté

parametre de mise a l'echelle du bloc dynamique( hauteur longueur )

echelle de l'espace objet

echelle de l'espace papier

sur ton fichier ca marche quand j'ai ca

echelle du bloc : en centimetre

echelle du bloc implanté : x=0.01 y=0.01 z=0.01

parametre de mise a l'echelle du bloc dynamique( hauteur longueur ) 413x290 ( ca correspond au a de cote en millimettres la meme echelle que l'espace papier désiré )

echelle de l'espace objet : en metre ( réglé dans la demande lisp )

echelle de l'espace papier : en millimetre ( réglé dans la demande lisp )

les lisp

CEP (adapté a mes exigences de travail )

CEP2 ( plus générique )

c'est ici que le lisp calcul les dimensions de la fenetre dans l'espace papier

(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)))
                      )
            )

et la que je cherche a calculer unit

(setq unit (/ (/ echelleespacepapier echelleespaceobjet) 10))

meme la je ne maitrise pas l'échelle d'implantation du bloc "IMAGE CADRE"

;;; Crée un onglet EP par cadre de page sélectionné en EO
;;; par Bred - Un onglet déjà paramétrer doit exister -
;;; Version 1.1
(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 typecadre (atof (getcfg "APPDATA/TYPECADRE")))
;;;(setq unit (cdr
;;;               (assoc (getvar "INSUNITS") '((4 . 1) (5 . 10) (6 . 1000)))
;;;             )
;;;  )
 (setq echelleespaceobjet (atof (getcfg "APPDATA/ECHELLEESPACEOBJET")))
 (initget 4)
 (setq tmp (getdist
             (strcat "\nENTRER L'ECHELLE DE L'ESPACE OBJET EN METRE <" (rtos echelleespaceobjet 2 8) ">: ")
           )
 )
 (if tmp
   (setq echelleespaceobjet tmp)
 )
 (setcfg "APPDATA/ECHELLEESPACEOBJET" (rtos echelleespaceobjet 2 8))
 (setq echelleespacepapier (atof (getcfg "APPDATA/ECHELLEESPACEPAPIER")))
 (initget 4)
 (setq tmp (getdist
             (strcat "\nENTRER L'ECHELLE DE L'ESPACE PAPIER EN METRE <" (rtos echelleespacepapier 2 8) ">: ")
           )
 )
 (if tmp
   (setq echelleespacepapier tmp)
 )
 (setcfg "APPDATA/ECHELLEESPACEPAPIER" (rtos echelleespacepapier 2 8))
 (setq unit (/ (/ echelleespacepapier echelleespaceobjet) 10))
 (while (not sel)
   (setq sel (car (entsel "\nCHOIX DU CADRE SOURCE (Bloc) :")))
   (if sel
     (if (not (equal (vla-get-objectname (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))
       (setq sel nil)
     )
   )
 )
 ;;
 (if (= (tblsearch "layer" "T_FENETRE") nil)
   (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "")
 )
 (setq cav (getvar "clayer"))
 (command-s "-calque" "ac" "T_FENETRE" "ch" "T_FENETRE" "")
 (setq rege (getvar "REGENMODE"))
 (setvar "REGENMODE" 1)
 (setvar "cmdecho" 0)
 (prompt "\nSELECTIONNER LES BLOCS CADRES POUR LA CREATION DES PRESENTATIONS :")
;;; (setq	SEL   (ssget '((0 . "INSERT")))
 (setq sel   (ssget (list '(0 . "INSERT") (cons 8 "T_FENETRE IMAGE")))
       acdoc (vla-get-activedocument (vlax-get-acad-object))
;;;	NOM-P (getstring t "\n Nom des Onglets à Créer :")
       lays  (layoutlist)
 )
 (setq compteur 0)
 (setq compteurmax (sslength sel))
 (prompt "\n 1 : JPG1188x1680")
 (prompt "\n 2 : PNG1188x1680")
 (prompt "\n 3 : JPG570x800")
 (prompt "\n 4 : A3H RDC 1-50 PL001-")
 (prompt "\n 5 : 00")
 (initget "1 2 3 4 5")
 (setq typecadre (getcfg "APPDATA/TYPECADRE"))
 (setq tmp (getstring t (strcat "\nSELECTIONNER LE TYPE DE CADRE A RECRER (1 2 3 4 5) < " typecadre " >: ")))
 (if (/= tmp "")
   (setq typecadre tmp)
 )
 (if (= typecadre "1")
   (setq ong-base "001 JPG1188x1680")
 )
 (if (= typecadre "2")
   (setq ong-base "002 PNG1188x1680")
 )
 (if (= typecadre "3")
   (setq ong-base "003 JPG570x800")
 )
 (if (= typecadre "4")
   (setq ong-base "A3H RDC 1-50 PL001-")
 )
 (if (= typecadre "5")
   (setq ong-base "00")
 )
 (setcfg "APPDATA/TYPECADRE" typecadre)
 (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 lstima   (getatt c)
                  nblstima (length lstima)
                  ima1     (cdr (nth 0 lstima))
                  ima2     (cdr (nth 1 lstima))
                  ima3     (cdr (nth 2 lstima))
                  ima4     (cdr (nth 3 lstima))
                  ima5     (cdr (nth 4 lstima))
                  ima6     (cdr (nth 5 lstima))
            )
            (setq ong_dest (strcat ;;ONG-BASE " "
                                   ima1
                           )
            )
            (if (/= ima2 "")
              (setq ong_dest (strcat ong_dest " " ima2))
            )
            (if (/= ima3 "")
              (setq ong_dest (strcat ong_dest " " ima3))
            )
            (if (/= ima4 "")
              (setq ong_dest (strcat ong_dest " " ima4))
            )
            (if (/= ima5 "")
              (setq ong_dest (strcat ong_dest " " ima5))
            )
            (if (/= ima6 "")
              (setq ong_dest (strcat ong_dest " " ima6))
            )
            (setq n-p (vla-add (vla-get-layouts acdoc) ong_dest))
            (setq ech (vla-get-yscalefactor 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))
            (setq compteur (1+ compteur))
            (command-s "espacep")
            (command-s "zoom" "et")
            (prompt (strcat "\nLE PROGRAMME A TRAITE : "
                            (rtos compteur 2 0)
                            " OPERATION(S) SUR : "
                            (rtos compteurmax 2 0)
                    )
            )
            (princ)
     )
   )
 )
 (setvar "TILEMODE" 1)
 (setvar "REGENMODE" rege)
 (setvar "cmdecho" 1)
 (setvar "clayer" cav)
 (prompt "\n")
 (princ)
)


;;; Crée un onglet EP par cadre de page sélectionné en EO
;;; par Bred - Un onglet déjà paramétrer doit exister -
;;; Version 1.1
(defun c:cep2 (/ 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)))
;;;             )
;;;  )
 (setq echelleespaceobjet (atof (getcfg "APPDATA/ECHELLEESPACEOBJET")))
 (initget 4)
 (setq tmp (getdist
             (strcat "\nENTRER L'ECHELLE DE L'ESPACE OBJET EN METRE <" (rtos echelleespaceobjet 2 8) ">: ")
           )
 )
 (if tmp
   (setq echelleespaceobjet tmp)
 )
 (setcfg "APPDATA/ECHELLEESPACEOBJET" (rtos echelleespaceobjet 2 8))
 (setq echelleespacepapier (atof (getcfg "APPDATA/ECHELLEESPACEPAPIER")))
 (initget 4)
 (setq tmp (getdist
             (strcat "\nENTRER L'ECHELLE DE L'ESPACE PAPIER EN METRE <" (rtos echelleespacepapier 2 8) ">: ")
           )
 )
 (if tmp
   (setq echelleespacepapier tmp)
 )
 (setcfg "APPDATA/ECHELLEESPACEPAPIER" (rtos echelleespacepapier 2 8))
 (setq unit (/ (/ echelleespacepapier echelleespaceobjet) 10))
 (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-yscalefactor 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)
)

;; GETATT
;; Retourne une liste d'association des attribut du bloc
;;
;; Argument
;; bl : la référence de bloc (ename ou vla-object)
;;
;; Retour
;; une liste d'association du type : ((etiquette . valeur) ...)

(defun getatt (bl)
 (vl-load-com)
 (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl)))
 (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true))
   (mapcar (function (lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x))))
           (vlax-invoke bl 'getattributes)
   )
 )
)

;; PUTATT
;; Donne les valeurs de la liste aux attributs du bloc
;;
;; Arguments
;; bl : la référence de bloc (ename ou vla-object)
;; lst : une liste d'association du type : ((etiquette . valeur) ...)
;;
;; Retour
;; une liste d'association du type des attributs traités

(defun putatt (bl lst / att ret)
 (vl-load-com)
 (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl)))
 (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true))
   (mapcar (function (lambda (x)
                       (if (setq att (assoc (vla-get-tagstring x) lst))
                         (progn (vla-put-textstring x (cdr att)) (setq ret (cons att ret)))
                       )
                     )
           )
           (vlax-invoke bl 'getattributes)
   )
 )
 ret
)

les lisp REGULAR DRAW

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; redessine tout correctement avec precision, coordonnees suivant le SCG
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun c:regular_draw_scg (/ js n_count prec ent dxf_ent dxf_lst)
 (setq js      (ssget
                 '((0
                    .
                    "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE,DIMENSION"
                   )
                  )
               )
       n_count -1
 )
 (cond (js
        (initget 6)
        (setq redprecis (atof (getcfg "APPDATA/REDPRECIS")))
        (setq prec1 (getreal
                      (strcat "\nFACTEUR D'ARRONDI A APPLIQUER AU POINT DE DEFINITION DES OBJETS, RAYON ET HAUTEUR DE TEXTE <"
                              (rtos redprecis 2 8)
                              "> :? "
                      )
                    )
        )
        (if (/= prec1 nil)
          (setq prec prec1)
          (setq prec redprecis)
        )
        (setcfg "APPDATA/REDPRECIS" (rtos prec 2 8))
        (setq prec (/ 1 prec))
        (setvar "cmdecho" 0)
        (command-s "_.undo" "_group")
        (while (setq ent (ssname js (setq n_count (1+ n_count))))
          (setq dxf_ent (entget ent))
          (cond ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
                 (setq dxf_lst (cdr dxf_ent)
                       dxf_ent (list (car dxf_ent))
                 )
                 (while (cdr dxf_lst)
                   (if (eq 10 (caar dxf_lst))
                     (setq dxf_ent (cons (cons 10 (mapcar '(lambda (x) (round_number x prec)) (cdar dxf_lst))) dxf_ent))
                     (setq dxf_ent (cons (car dxf_lst) dxf_ent))
                   )
                   (setq dxf_lst (cdr dxf_lst))
                 )
                 (setq dxf_ent (reverse dxf_ent))
                )
                ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
                 (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
                   (setq dxf_ent (subst (cons 10 (mapcar '(lambda (x) (round_number x prec)) (cdr (assoc 10 dxf_ent))))
                                        (assoc 10 dxf_ent)
                                        dxf_ent
                                 )
                   )
                   (entmod dxf_ent)
                 )
                )
                (t
                 (foreach n dxf_ent
                   (if (member (car n) '(10 11 12 13 14 40))
                     (if (listp (cdr n))
                       (setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x) (round_number x prec)) (cdr n)))
                                            (assoc (car n) dxf_ent)
                                            dxf_ent
                                     )
                       )
                       (setq dxf_ent (subst (cons (car n) (round_number (cdr n) prec)) (assoc (car n) dxf_ent) dxf_ent))
                     )
                   )
                 )
                )
          )
          (entmod dxf_ent)
          (entupd ent)
        )
        (command-s "_.undo" "_end")
        (setvar "cmdecho" 1)
        (princ (strcat "\n" (itoa n_count) " objet(s) transformé(s)."))
       )
       (t (princ "\Aucun objet valide trouvé."))
 )
 (prin1)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; redessine tout correctement avec precision, coordonnees suivant le SCu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:regular_draw_scu (/ js n_count prec ent dxf_ent dxf_lst)
 (setq js      (ssget
                 '((0
                    .
                    "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE,DIMENSION"
                   )
                  )
               )
       n_count -1
 )
 (cond (js
        (initget 6)
        (setq redprecis (atof (getcfg "APPDATA/REDPRECIS")))
        (setq prec1 (getreal
                      (strcat "\nFACTEUR D'ARRONDI A APPLIQUER AU POINT DE DEFINITION DES OBJETS, RAYON ET HAUTEUR DE TEXTE <"
                              (rtos redprecis 2 8)
                              "> :? "
                      )
                    )
        )
        (if (/= prec1 nil)
          (setq prec prec1)
          (setq prec redprecis)
        )
        (setcfg "APPDATA/REDPRECIS" (rtos prec 2 8))
        (setq prec (/ 1 prec))
        (setvar "cmdecho" 0)
        (command-s "_.undo" "_group")
        (while (setq ent (ssname js (setq n_count (1+ n_count))))
          (setq dxf_ent (entget ent))
          (cond ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
                 (setq dxf_lst (cdr dxf_ent)
                       dxf_ent (list (car dxf_ent))
                 )
                 (while (cdr dxf_lst)
                   (if (eq 10 (caar dxf_lst))
                     (setq dxf_ent (cons (cons 10 (trans (mapcar '(lambda (x) (round_number x prec)) (trans (cdar dxf_lst) 0 1)) 1 0))
                                         dxf_ent
                                   )
                     )
                     (setq dxf_ent (cons (car dxf_lst) dxf_ent))
                   )
                   (setq dxf_lst (cdr dxf_lst))
                 )
                 (setq dxf_ent (reverse dxf_ent))
                )
                ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
                 (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
                   (setq dxf_ent (subst (cons 10
                                              (trans (mapcar '(lambda (x) (round_number x prec)) (trans (cdr (assoc 10 dxf_ent)) 0 1)) 1 0)
                                        )
                                        (assoc 10 dxf_ent)
                                        dxf_ent
                                 )
                   )
                   (entmod dxf_ent)
                 )
                )
                (t
                 (foreach n dxf_ent
                   (if (member (car n) '(10 11 12 13 14 40))
                     (if (listp (cdr n))
                       (setq dxf_ent (subst (cons (car n) (trans (mapcar '(lambda (x) (round_number x prec)) (trans (cdr n) 0 1)) 1 0))
                                            (assoc (car n) dxf_ent)
                                            dxf_ent
                                     )
                       )
                       (setq dxf_ent (subst (cons (car n)
                                                  ;;(trans
                                                  (round_number ;;(trans
                                                                (cdr n)
                                                                ;; 0 1)
                                                                prec
                                                  )
                                                  ;;1 0)
                                            )
                                            (assoc (car n) dxf_ent)
                                            dxf_ent
                                     )
                       )
                     )
                   )
                 )
                )
          )
          (entmod dxf_ent)
          (entupd ent)
        )
        (command-s "_.undo" "_end")
        (setvar "cmdecho" 1)
        (princ (strcat "\n" (itoa n_count) " objet(s) transformé(s)."))
       )
       (t (princ "\Aucun objet valide trouvé."))
 )
 (prin1)
)

(defun round_number (xr n /) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n)))

a+

Phil

lili2006 · le 12 février 2021

Re,

Super, encore merci a vous deux !

Je regarde dés que possible et reviens vers vous.

lili2006 · le 12 février 2021

Re,

J'ai testé les deux Lisps CPP, marche impec, Bravo Bryce (Et merci Patrice)

REGULAR DRAW, fonctionne aussi sauf que je ne sais pas m'en servir,..

A la question :

Commande: REGULAR_DRAW_SCG
8 trouvé(s)
FACTEUR D'ARRONDI A APPLIQUER AU POINT DE DEFINITION DES OBJETS, RAYON ET HAUTEUR DE TEXTE :?

Je ne vois pas quoi bien répondre,..

Et quand aux différents Lisps fourni ci dessus, je les compiles sur un seul fichier ?

Je vais tester à suivre les réglages que tu préconises dans mon cas.

Mais je vais quand mêem cherché à faire un cadre simple (rectangle) en bloc à la bonne dimension, je galererai peut être moins avec les echelles,..

"Manuellement", j'associé la vue de l'espace objet à celle du papier avec un facteur de 1 (1000 mm / m x 1/100, echelle désirée = 1)

Merci encore pour votre aide car ce n'est pas si simple cette affaire,..

DenisHen · le 14 février 2021

Salut à tous...

J'ai longtemps chercher à passer outre le bloc "cadre" pour passer à la polyligne... Qui est beaucoup plus souple, pour l'utilisateur, mais incroyablement plus complexe pour le développeur.

J'avais essayé un truc, dont Maître Gilles m'avait donné un début de code que je n'ai jamais réussi à approfondir... Je ne suis peut-être pas à la hauteur... Ca parlait de "x-data", il m'a semblé, liées avec cette entité... Je n'ai jamais réussi à faire un truc avec ça, et je ne voulais plus le déranger, car il m'avait déjà bien aidé et bien orienté, et ce, depuis des années... Car il n'est pas nouveau le bougre...

Mais je suis sûr qu'avec plus de données et plus d'expérience, on pourrait se débarrasser du bloc "A3" ou "A4", horizontal ou vertical, et se permettre de le faire avec une simple polyligne...

J'ai cherché longtemps à le faire, mais mes capacités intellectuelles ont peut-être été dépassées...

Seul Maître (gile), Je pense, car on est tous d'accord, il est SUPERBALÈSE ! ! ! ! !. (ou un crustacé, Je sais, d'autres auraient pu, mais qu'ils se présentent...) pourrait nous aider, car leurs connaissances, et on le sait tous, sont démesurées... (gile), si tu nous regardes... Reçois déjà toute notre sympathie et notre admiration...

Mais si on pouvait passer d'une polyligne en espace objet vers une présentation dans un espace papier... Wouaouw ! ! ! On fera tous un grand pas dans ce domaine...

Bon, gros bisous à toutes, et PDM à tous les mecs...

Denis...

Olivier Eckmann · le 14 février 2021

Bonjour,

REGULAR_DRAW permet d'arrondir les coordonnées et dimensions des objets à une valeur arrondie.

Par exemple, si tu réponds 0.05, alors tous les sommets d'une polyligne, d'une ligne, le centre du cercle, le point d'insertion du bloc, etc seront arrondies à 0.05 près.

Idem pour la hauteur des textes. Par ex si un texte fait 1.53 de haut, sa hauteur sera modifiée pour faire 1.55. Si ça fait 0.92, alors ça sera arrondi à 0.90.

Ce que tu rentres au moment de la demande, c'est la valeur d'arrondi souhaitée pour tous les types d'objets .

Olivier

lili2006 · le 15 février 2021

Bonjour à toutes et tous,

Compris, merci Olivier !

PHILPHIL · le 16 février 2021

HELLO

j'ai modifié le Lisp de FRED

bon, c'est pas écrit très proprement pour les puristes pour mon rajout mais ca fonctionne et dépanne

il faut créer une polyligne rectangulaire du meme format que celui désiré dans l'espace papier dans le calque "T_FENETRE IMAGE"

ou supprimer ceci dans le lisp

(cons 8 "T_FENETRE IMAGE")

il faut aussi connaitre le facteur d’échelle du cadre polyligne dessiné dans l'espace objet par rapport a la fenetre dans l'espace papier de destination

si espace papier en millimètre pour un A4V(erticale) : fenetre = 204x267

cadre polyligne = 204x267

facteur =1

si espace papier en millimètre pour un A4V(erticale) : fenetre = 204x267

cadre polyligne = 102x133.5

facteur =0.5

si espace papier en millimètre pour un A4V(erticale) : fenetre = 204x267

cadre polyligne = 408x534

facteur =2

(defun c:cep2_polyligne (/ 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 facteurechellepoly (atof (getcfg "APPDATA/FACTEURECHELLEPOLY")))
 (initget 4)
 (setq tmp (getdist
             (strcat "\nENTRER LE FACTEUR D'ECHELLE DE LA POLYLIGNE CADRE DANS L'ESPACE OBJET PAR RAPPORT A LA FENETRE PAPIER <"
                     (rtos facteurechellepoly 2 8)
                     ">: "
             )
           )
 )
 (if tmp
   (setq facteurechellepoly tmp)
 )
 (setcfg "APPDATA/FACTEURECHELLEPOLY" (rtos facteurechellepoly 2 8))
 (setq unit (/ 1 facteurechellepoly))
 (setq sel   (ssget (list '(0 . "LWPOLYLINE") (cons 8 "T_FENETRE IMAGE")))
       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)
   (setq c (vlax-ename->vla-object (ssname sel i)))
   (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)))))
          (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)))))
                                      (setq haut (* unit (- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin)))))
                    )
          )
          (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)
)

a+

Phil

lili2006 · le 20 février 2021

Bonjour à toutes et tous,

Super, Merci PHILPHIL,

Je souhaite garder mon bloc dans le calque ""T_FENETRE IMAGE"", est-ce que ce Lisp le permet ? (Pas moyen de tester pour le moment,..)

si espace papier en millimètre pour un A4V(erticale) : fenetre = 204x267
cadre polyligne = 408x534
facteur =2

En suivant cette logique, pour mon A3H à l'échelle 1/1000, je fais donc :

si espace papier en millimètre pour un A3H(orizontal) : fenetre = 294x417

cadre polyligne = 294x417

facteur =1

??

D'avance, merci,

PHILPHIL · le 21 février 2021

hello Lili

attention le Lisp au dessus fonctionne avec un rectangle donc une polyligne et non plus avec un bloc implanté dans l'espace papier

a+, Phil

lili2006 · le 22 février 2021

Bonjour à toutes et tous,

Salut PHILPHIL,

attention le Lisp au dessus fonctionne avec un rectangle donc une polyligne

Oui, d'où mon interrogation,..Je préfère garder mon bloc car il sert aussi de repérage sur un onglet indépendant à une autre échelle, de la position des différents feuillets,..

Te souviens tu des paramètres utilisés dans l'exemple que tu m'avais fait sur ce post ?

Cette version me conviendrait parfaitement,..

Encore merci !

quentinQS · le 3 mars 2021

Bonjour à tous

Quand je lance la commande NOG rien ne se passe !

PHILPHIL · le 28 avril 2021

HELLO

commande : CEP4

une mise a jour de "CEP" de FRED a tester et a modifier suivant vos critères

avec un bloc servant de référence fenêtre orienté dans n'importe quel SCU

a tester avec le fichier *.dwg "ACAD 2013 -TEXT CADRE IMAGE"

les attributs servent a nommer la présentation, J'utilise cette méthode mais une autre méthode est possible

la concaténation des attributs doit etre unique, sinon le lisp se bloque, ne pouvant pas créer deux présentations de même noms

le point de référence du bloc permetant de créer la fenêtre est au centre

on ajuste la LARGEUR et la HAUTEUR du bloc en fonction de la fenêtre voulue et correspondant a un multiple des largeur hauteur des fenêtres de présentations

en multipliant LARGEUR et HAUTEUR on change l'échelle

je bosse en centimètre et mes présentations sont en millimètres

ca peut avoir son importance si vous travaillez dans d'autres unités, il vous faudra adapter des paramètres dans le lisp

le bloc "CADRE IMAGE" doit etre implanter dans "T_FENETRE IMAGE" ( sinon adapter le lisp )

sélectionner les type cadres de meme orientations ( HORIZONTAUX ou VERTICAUX ) sans distinction de format a la volée et le lisp fera la mise en page

il suffira ensuite d'utiliser "CPP_FIXE" pour copier les entités de cartouches entre présentations

pour UNE fenêtre par présentation

paramètres a modifier dans le LISP suivant le type de fenêtre de présentation : voir onglet "A4V 1-X PL001-" et "A4H 1-X PL001-"

l'origine de mon "SCU" dans mes présentations est en bas a droite

pointcentre1 (list -105.0 160.5 0.0)   : point central de la fenêtre dans la présentation
                     rot          ac0degrees    : un angle suivant si la fenêtre est verticale ou horizontale dans la présentation "ac90degrees" = HORIZONTALE
                     largeur      204.0       : LARGEUR de la fenêtre dans votre présentation d'arrivée
                     hauteur      267.0     : HAUTEUR de la fenêtre dans votre présentation d'arrivée

a+

Phil

(defun c:cep4 (/ 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 typecadre (atof (getcfg "APPDATA/TYPECADRE")))
;;;(setq unit (cdr
;;;               (assoc (getvar "INSUNITS") '((4 . 1) (5 . 10) (6 . 1000)))
;;;             )
;;;  )
  (setq separa1 (getcfg "APPDATA/SEPARA1"))
  (setq tmp (getstring t (strcat "\nENTRER LE SEPARATEUR ENTRE ATTRIBUT A INTEGRER <" separa1 "> : ")))
  (if (/= tmp "")
    (setq separa1 tmp)
  )
  (setcfg "APPDATA/SEPARA1" separa1)
  (while (not sel)
    (setq sel (car (entsel "\nCHOIX DU CADRE SOURCE (Bloc) :")))
    (if sel
      (if (not (equal (vla-get-objectname (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))
        (setq sel nil)
      )
    )
  )
  (if (= (tblsearch "layer" "T_FENETRE") nil)
    (command-s "-calque" "n" "T_FENETRE" "co" "7" "T_FENETRE" "")
  )
  (setq cav (getvar "clayer"))
  (command-s "-calque" "ac" "T_FENETRE" "ch" "T_FENETRE" "")
  (setq rege (getvar "REGENMODE"))
  (setvar "REGENMODE" 1)
  (setvar "cmdecho" 0)
  (prompt "\nSELECTIONNER LES BLOCS CADRES POUR LA CREATION DES PRESENTATIONS :")
  (setq sel   (ssget (list '(0 . "INSERT") (cons 8 "T_FENETRE IMAGE")))
        acdoc (vla-get-activedocument (vlax-get-acad-object))
        lays  (layoutlist)
  )
  (setq compteur 0)
  (setq compteurmax (sslength sel))
  (prompt "\n 1 : A4V 1-X PL001-")
  (prompt "\n 2 : A4H 1-X PL001-")
  (initget "1 2 3 4 5 6")
  (setq typecadre (getcfg "APPDATA/TYPECADRE"))
  (setq tmp (getstring t (strcat "\nSELECTIONNER LE TYPE DE CADRE A RECRER (1 2 3 4 5) < " typecadre " >: ")))
  (if (/= tmp "")
    (setq typecadre tmp)
  )
  (if (= typecadre "1")
    (setq ong-base "A4V 1-X PL001-")
  )
  (if (= typecadre "2")
    (setq ong-base "A4H 1-X PL001-")
  )
  (setcfg "APPDATA/TYPECADRE" typecadre)
  (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 (setq baserotation (vlax-get-property (vlax-ename->vla-object (ssname sel i)) 'rotation)
                   poitinsert   (vlax-safearray->list
                                  (vlax-variant-value (vlax-get-property (vlax-ename->vla-object (ssname sel i)) 'insertionpoint))
                                )
                   largcadre    (getpropertyvalue (cdr (assoc -1 (entget (ssname sel i)))) "AcDbDynBlockPropertyLARGEUR CADRE")
                   hautcadre    (getpropertyvalue (cdr (assoc -1 (entget (ssname sel i)))) "AcDbDynBlockPropertyHAUTEUR CADRE")
                   x1           (car poitinsert)
                   y1           (cadr poitinsert)
                   bgx          (- (car poitinsert) (/ largcadre 2))
                   bgy          (- (cadr poitinsert) (/ hautcadre 2))
                   hdx          (+ (car poitinsert) (/ largcadre 2))
                   hdy          (+ (cadr poitinsert) (/ hautcadre 2))
                   lstima       (getatt c)
                   nblstima     (length lstima)
                   ima1         (cdr (nth 0 lstima))
                   ima2         (cdr (nth 1 lstima))
                   ima3         (cdr (nth 2 lstima))
                   ima4         (cdr (nth 3 lstima))
                   ima5         (cdr (nth 4 lstima))
                   ima6         (cdr (nth 5 lstima))
                   ima7         (cdr (nth 6 lstima))
                   ima8         (cdr (nth 7 lstima))
             )
             (setq ong_dest (strcat ima1))
             (if (/= ima2 "")
               (setq ong_dest (strcat ong_dest separa1 ima2))
             )
             (if (/= ima3 "")
               (setq ong_dest (strcat ong_dest separa1 ima3))
             )
             (if (/= ima4 "")
               (setq ong_dest (strcat ong_dest separa1 ima4))
             )
             (if (/= ima5 "")
               (setq ong_dest (strcat ong_dest separa1 ima5))
             )
             (if (/= ima6 "")
               (setq ong_dest (strcat ong_dest separa1 ima6))
             )
             (if (/= ima7 "")
               (setq ong_dest (strcat ong_dest separa1 ima7))
             )
             (if (/= ima8 "")
               (setq ong_dest (strcat ong_dest separa1 ima8))
             )
             (if (= (strlen ima7) 1)
               (setq nombre (strcat "00" ima7))
             )
             (if (= (strlen ima7) 2)
               (setq nombre (strcat "0" ima7))
             )
             (if (= (strlen ima7) 3)
               (setq nombre ima7)
             )
             (if (= typecadre "1")
               (setq ong_dest     (strcat "A4V " ong_dest " 1-X PL" nombre "-");; un nom de presentation different
                     pointcentre1 (list -105.0 160.5 0.0)
                     rot          ac0degrees
                     largeur      204.0
                     hauteur      267.0
               )
             )
             (if (= typecadre "2")
               (setq ong_dest     (strcat "A4H " ong_dest " 1-X PL" nombre "-");; un nom de presentation different
                     pointcentre1 (list -148.5 117.0 0.0)
                     rot          ac90degrees
                     largeur      291.0
                     hauteur      180.0
               )
             )
             (setq n-p (vla-add (vla-get-layouts acdoc) ong_dest))
             (setq ech (vla-get-yscalefactor c))
             (vla-copyfrom n-p a-p)
             (vla-put-activelayout acdoc n-p)
             (setq fen (vla-addpviewport (vla-get-paperspace acdoc)
                                         (vlax-3d-point pointcentre1)
                                         largeur
                                         hauteur
                       )
             )
             (vla-put-layer fen lay)
             (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) (vlax-3d-point bgx bgy 0.0) (vlax-3d-point hdx hdy 0.0))
             (vla-put-mspace acdoc :vlax-false)
             (vla-put-plotrotation (vla-get-activelayout acdoc) rot)
             (command-s "espaceo")
             (setq ucs1 (getvar "ucsfollow"))
             (setvar "osmode" 0)
             (setvar "orthomode" 0)
             (setvar "ucsfollow" 0)
             (setq p2 (polar poitinsert baserotation 1000))
             (command-s "_DVIEW" "" "_TW" (- 360 (* (angle poitinsert p2) (/ 180 pi))) "")
             (setvar "ucsfollow" ucs1)
             (command-s "espacep")
             (vla-put-displaylocked fen lock)
             (setq i (1+ i))
             (setq compteur (1+ compteur))
             (command-s "zoom" "et")
             (prompt (strcat "\nLE PROGRAMME A TRAITE : "
                             (rtos compteur 2 0)
                             " OPERATION(S) SUR : "
                             (rtos compteurmax 2 0)
                     )
             )
             (princ)
      )
    )
  )
  (setvar "TILEMODE" 1)
  (setvar "REGENMODE" rege)
  (setvar "cmdecho" 1)
  (setvar "clayer" cav)
  (prompt "\n")
  (princ)
)

(defun c:cpp_FIXE (/ acdoc layouts selectedlayouts *error* lay ss sa) ; Bryce, janvier 2012
 ; Copie les objets sélectionnés dans les présentations choisies.
  (vl-load-com)
  (setq layouts (vla-get-layouts (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))))
  (defun *error* (msg)
    (and msg
         (or (member (strcase msg)
                     '("FUNCTION CANCELLED" "QUIT / EXIT ABORT" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON")
             )
             (princ (strcat "\nErreur : " msg))
         )
    )
    (if ss
      (setq ss nil)
    )
    (vla-endundomark acdoc)
    (princ)
  )
  (vla-startundomark acdoc)
  (or (and (/= (getvar 'ctab) "Model") (= (getvar 'cvport) 1))
      (progn (princ "\n** Commande non autorisée dans l'espace Objet**") (quit))
  )
  (if (and (or (setq ss (cadr (ssgetfirst))) (setq ss (ssget))) (setq sa (bs:ss2safearray ss)))
    (progn (setq selectedlayouts (bs:getotherlayouts nil t))
           (foreach lay selectedlayouts (vla-copyobjects acdoc sa (vla-get-block (vla-item layouts lay)))) ; foreach
           (princ "\nCopie effectuée !")
    )
  ) ;if ssget
  (*error* nil)
)

;;---------------------------------------------------------------------------------------------------------------------------------------------------------------
;;---------------------------------------------------------------------------------------------------------------------------------------------------------------

;; BS:GETOTHERLAYOUTS Bryce 19/01/2012
;; basé sur GETLAYOUTS (gile) 03/12/07
;;
;; Retourne la liste des présentations choisies dans la boite de dialogue
;; La présentation active n'est pas proposée.
;;
;; arguments
;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s)
;; mult : T ou nil (pour choix multiple ou unique)

(defun bs:getotherlayouts (titre mult / lay tmp file ret)
  (setq lay  (vl-sort (vl-remove (getvar 'ctab) (layoutlist))
                      (function (lambda (x1 x2) (< (taborder x1) (taborder x2))))
             )
        tmp  (vl-filename-mktemp "tmp.dcl")
        file (open tmp "w")
  )
  (write-line (strcat "GetLayouts:dialog{label="
                      (if titre
                        (vl-prin1-to-string titre)
                        (if mult
                          "\"Choisir les présentations\""
                          "\"Choisir une présentation\""
                        )
                      )
                      ";:list_box{height = 80;key=\"lst\";multiple_select="
                      (if mult
                        "true;width = 80;}:row{:retirement_button{label=\"Toutes\";key=\"all\";}
ok_button;cancel_button;}}"
                        "false;}ok_cancel;}"
                      )
              )
              file
  )
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "GetLayouts" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list lay)
  (end_list)
  (action_tile "all" "(setq ret (reverse lay)) (done_dialog)")
  (action_tile "accept"
               "(or (= (get_tile \"lst\") \"\")
(foreach n (str2lst (get_tile \"lst\") \" \")
(setq ret (cons (nth (atoi n) lay) ret))))
(done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  (reverse ret)
)

(defun taborder (name / dict lay) ; (gile)
  (setq dict (dictsearch (namedobjdict) "ACAD_LAYOUT"))
  (if (setq lay (cdr (assoc 350 (member (cons 3 name) dict))))
    (cdr (assoc 71 (entget lay)))
  )
)

(defun str2lst (str sep / pos) ; (gile)
  (if (setq pos (vl-string-search sep str))
    (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep))
    (list str)
  )
)

(defun bs:ss2safearray (sset / i entlst) ; Bryce
  (setq i 0)
  (repeat (sslength sset)
    (setq entlst (cons (vlax-ename->vla-object (ssname sset i)) entlst))
    (setq i (1+ i))
  )
  (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length entlst)))) entlst)
)

;; GETATT
;; Retourne une liste d'association des attribut du bloc
;;
;; Argument
;; bl : la référence de bloc (ename ou vla-object)
;;
;; Retour
;; une liste d'association du type : ((etiquette . valeur) ...)

(defun getatt (bl)
  (vl-load-com)
  (or (= (type bl) 'vla-object) (setq bl (vlax-ename->vla-object bl)))
  (if (and (= (vla-get-objectname bl) "AcDbBlockReference") (= (vla-get-hasattributes bl) :vlax-true))
    (mapcar (function (lambda (x) (cons (vla-get-tagstring x) (vla-get-textstring x))))
            (vlax-invoke bl 'getattributes)
    )
  )

ACAD 2013 -TEXT CADRE IMAGE.dwg

Presentations multiples : Automatisation

Messages recommandés

Meilleurs contributeurs dans ce sujet

Jours populaires

Meilleurs contributeurs dans ce sujet

Jours populaires

Messages populaires

PHILPHIL

Jérém

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante