Ordre de tracé perdu

[Matt666]

Bonjour à tous,

 

J'ai un petit blocage sur une routine et j'aimerais un peu d'aide.

Cette routine, qui rend un bloc sélectionné unique, fonctionne très bien mais les entités du nouveau bloc perdent l'ordre de tracé défini dans le bloc source.

 

Voici le code :

;Name:  			BU
;Version:   		1.2
;Bcad Version:  After V8
;Date:  			2017
;Description:   rendre un bloc unique
;History:
;v1.0	2017			1ère version
;v1.1	20190319	Amélioration du code
;v1.2 20190523	Prend en compte l'ordre des objets

(defun c:BU ( / *error* acdoc osmode sel e n os bl l str ns dxf)

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

;LST2STR (gile)	
(defun lst2str (lst sep)
	(if (cadr lst)
		(strcat (vl-princ-to-string (car lst))
			sep
			(lst2str (cdr lst) sep)
		)
		(vl-princ-to-string (car lst))
	)
)

(vl-load-com)

;Fonction d'erreur
(defun *error* (msg)
	(if 
		(and 
			msg
			(not (vl-position msg '("Fonction annulée" "Function cancelled" "quit / exit abort")))
		)
		(princ (strcat (if (= "fr_FR" (getvar 'locale)) "\nErreur: " "\Error: " ) msg))
	)
	(setvar 'cmdecho 1)
	(setvar 'osmode osmode)
	(vla-endUndoMark acdoc)
	(princ)
)

;table de tri des entités du dessin
(setq 
	osmode (getvar 'osmode)
	acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
)

(if (not
	(and 
		(setq sel (ssget "i"))
		(eq 1 (sslength sel))
		(eq "INSERT" (cdr (assoc 0 (entget (setq e (ssname sel 0))))))
	))
	(while (not 
		(and 
			(setq e (entsel "\nSelectionner le bloc à rendre unique : "))
			(eq (cdr (assoc 0 (entget (setq e (car e))))) "INSERT")
		)
	))
)
(setq 
	n 1
	os (cdr (assoc 2 (setq e (entget e))))
	bl (ai_table "block" 2)
)

; trouver un nom a la nouvelle reference
(if (setq l (str2lst os "#"))
	(if (< (length l) 2)
		(while (member (setq str (strcat (car l) "#" (itoa n))) bl)
			(setq n (1+ n))
		)
		;if not
		(progn
			(setq str (lst2str (reverse (cdr (reverse l))) "#"))
			(while (member (setq str (strcat (car l) "#" (itoa n))) bl)
				(setq n (1+ n))
			)
		)
	)
	;if not
	(while (member (setq str (strcat os "#" (itoa n))) bl)
		(setq n (1+ n))
	)
)

(setq ns (getstring T (strcat "\nNouveau nom du bloc '" (cdr (assoc 2 e)) "' <" str "> : ")))
(if (eq ns "") (setq ns str))
(if (tblsearch "block" ns)
	(progn 
		(princ "\nNom de bloc existant dans la base.")
		(exit)
	)
)

(vla-startUndoMark acdoc)

(setvar 'cmdecho 0)
(setvar 'osmode 0)

; trouver la reference de bloc
(setq dxf (cdr (assoc -2 (tblsearch "block" os))))

;header definition:
(entmake 
	(list '(0 . "BLOCK")
		(cons 2 ns)
		'(70 . 2)
		(cons 10 '(0 0 0))
	)
)

;body definition:
(while dxf
	(entmake (cdr (entget dxf)))
	(setq dxf (entnext dxf))
)

;footer definition:
(entmake '((0 . "ENDBLK")))

(vle-entmod 2 (cdr (assoc -1 e)) ns)

(princ (strcat "\nBloc '" os "' rendu unique '" ns "'."))
(*error* nil)
)

Déjà, le code fonctionne t'il chez vous ? Il fonctionne très bien sur BricsCAD.Avez-vous une idée ?

Merci ! Matt.

[Olivier Eckmann]

Bonjour,

 

A ma connaissance, l'ordre de tracé est stocké dans le dictionnaire des SORTENTS et comme tout dictionnaire il est stocké par DWG mais pas par définition du bloc. donc si tu recopies la définition, tu recopies dans l'ordre de création dans la database et pas dans l'ordre de tracé, donc pour moi c'est un comportement normal, peut-être pas souhaitable, mais conforme à la structure AutoCAD.

 

Olivier

[Matt666]

Ok je vois. Tu m'as donnée une idée : Reprendre l'ordre de tracé de l'ancienne définition pour la copier sur la nouvelle. A tester. Merci !

[Matt666]

Ca ne fonctionne pas.

 

J'ai essayé d'utiliser la commande vla-swaporder de l'entité de l'ancien bloc vers celle du nouveau, mais rien n'y fait.

;reprendre l'ordre de tracé de la définition source
(setq dict (vla-getextensiondictionary (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))))
(if (not (zerop (vla-get-count dict)))
	(setq tbl (vla-getobject dict "ACAD_SORTENTS"))
	(setq tbl (vla-addobject dict "ACAD_SORTENTS" "AcDbSortentsTable"))
)	;recupérer les entités de l'ancienne définition
	(setq dxf (cdr (assoc -2 (tblsearch "block" os))))
(while dxf
	(setq 
		osl (cons dxf osl)
		dxf (entnext dxf)
	)
)
;recupérer les entités de la nouvelle définition
(setq dxf (cdr (assoc -2 (tblsearch "block" ns))))
(while dxf
	(setq 
		nsl (cons dxf nsl)
		dxf (entnext dxf)
	)
)
(repeat (setq n (length osl))
   	(setq 
   		n (1- n)
   		obj (vlax-ename->vla-object (nth n osl))
   		nbj (vlax-ename->vla-object (nth n nsl))
   	)
   	;(vla-swaporder tbl obj nbj)
   	(vla-swaporder tbl nbj obj)
)

 

[(gile)]

Salut,

 

L'ordre de tracé est stocké dans un objet "ACAD_SORTENTS" (de type AcDbSortentsTable) qui est une entrée du dictionnaire d'extension d'un "enregistrement de bloc" (AcAdBlockTableRecord) soit un espace ou une définition de bloc.

Sur cette page, le fichier gc_Sortents.lsp fournit une bibliothèque de fonctions LISP pour gérer les ordres de tracé.

[Matt666]

Salut Gilles,

Merci pour la bibliothèque, bien utile, rien que pour comprendre un peu mieux les ordres de tracé.

 

On est d'accord que la liste d'objets (olst) demandée dans la fonction gc:SetRelativeDrawOrder est une entité de type liste, du genre (list obj1 obj2 obj3), est pas un truc en vl- que je ne comprends pas encore ?

 

De plus il me faut piocher dans l'ordre de tracé d'un block record pour l'insérer dans un autre block record. La fonction swaporder me plaisait bien mais elle ne peut 'ranger' des entités que dans une table, et pas dans 2. En Lisp je m'en sortirais assez bien je pense, mais je ne sais même pas comment ouvrir une entité en vl... Nul.

 

Par exemple je ne sais pas comment voir (ou ouvrir) les entités composant la table de tracé (ou déployer la liste pour mieux la comprendre) et/ou quelle est l'information qui range les entités au sein de la table (l'ordre de tri dans la table ?).

 

Si je pouvais récupérer l'information de tri d'une entité appartenant d'une table appartenant à un bloc X pour l'insérer dans une entité d'une table d'un bloc Y ce serait l'idéal, mais je sèche là dessus.

 

Merci de votre aide.

[(gile)]

On est d'accord que la liste d'objets (olst) demandée dans la fonction gc:SetRelativeDrawOrder est une entité de type liste, du genre (list obj1 obj2 obj3), est pas un truc en vl- que je ne comprends pas encore ?

Il s'agit bien d'une liste LISP classique mais dont les éléments (obj1 obj2 obj3) sont de type VLA-OBJECT, c'est à dire l'équivalent vla d'un ENAME (on convertit d'un type à l'autre avec vlax-ename->vla-object ou vlax-vla-object->ename).

 

De plus il me faut piocher dans l'ordre de tracé d'un block record pour l'insérer dans un autre block record.

C'est à mon avis la principale difficulté, si tu regardes l'aide pour l'objet SortentsTable (ou si tu fais un vlax-dump-object), tu verras qu'il n'y a une méthode GetFullDrawOrder qui permet de récupérer la collection des objets contenus dans la définition de bloc triés par ordre de tracé, mais ces objets ne sont pas ceux de ta nouvelle définition de bloc (il n'ont pas le même identifiant) il va donc falloir les comparer pour trouver les nouveaux objets correspondants aux anciens.

 

Par exemple je ne sais pas comment voir (ou ouvrir) les entités composant la table de tracé (ou déployer la liste pour mieux la comprendre) et/ou quelle est l'information qui range les entités au sein de la table (l'ordre de tri dans la table ?).

Quand tu es face à un objet "vla" (COM/ActiveX), tu cherches dans l'aide aux développeurs section Reference ActiveX ou tu utilises la fonction vlax-dump-object qui te renvoie la liste des propriété (et leurs valeurs) plus les méthode si tu spécifie T comme deuxième argument.