Créer un Xrecord avec un code de groupe supérieur à 369

[GEGEMATIC]

Bonjour,

J'aimerai créer un xrecord avec un code supérieur à 369:

L'aide d'autocad dit :

 

Codes de groupe Xrecord

 

Code de groupe Description

 

100 Marqueur de sous-classe (AcDbXrecord)

 

280 Drapeau de clonage d'enregistrement dupliqué (indique comment fusionner les entrées en double) :

 

0 = Non applicable

 

1 = Conserver l'élément existant

 

2 = Utiliser un clone

 

3 = $0$

 

4 = $0$

 

5 = Ne pas modifier le nom

 

1-369 (sauf 5 et 105) Ces valeurs peuvent être utilisées par une application quelle qu'elle soit

 

 

 

Mais moi je trouve des Xrecord (Covadis) :

((-1 . ) (0 . "XRECORD") (5 . "CF") (102 ..

"{ACAD_REACTORS") (330 . ) (102 . "}") (330 .

d'entité: 7359e6d8>) (100 . "AcDbXrecord") (280 . 1) (1000 . "préfixe Elec2")

(1000 . "Libelé Obstacle électrique") (1000 . "Electricité") (1040 . 8.88) (1040

.. 0.0) (1040 . 1.0) (1040 . 1.0) (1040 . 1.0) (1005 . "0"))

 

Donc on peu écrire des codes supérieurs à 369

mais quand j'essaye (par le lisp)

j'obtiens une erreur:

"groupe DXF incorrect: (1000 . \"Libelé Obstacle électrique\")"

Des idées ? En VBA, c'est pareil ?

--

[Patrick_35]

Salut

L'exemple que tu donnes utilise les xdatas (ou données étendues)

Voici un exemple en vlisp (aussi possible en autolisp, lance une recherche) que tu pourras traduire en vba.

 

(setq ent (vlax-ename->vla-object (car (entsel)))) ; sélection d'un objet

(setq data (list (cons 1001 "Application")
	 (cons 1000 "Juste un commentaire")
	 (cons 1002 "{")
	 (cons 1040 10.45) ; Une valeur réelle
	 (cons 1002 "}")
   )

     NewData (vlax-make-safearray vlax-vbVariant (cons 0 (1- (length data))))
     NewType (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length data))))
)

(vlax-safearray-fill newtype (mapcar 'car data))
(vlax-safearray-fill newData (mapcar 'cdr data))
(vla-setxdata ent NewType NewData)

 

Pour vérifier que ton xdata à bien été attaché à ton objet, tu peux utiliser la commande _xdlist des express tools

Et pour le fun, regarde dans une présentation dans un fmult (s'il y des calques gelés) avec cette commande

 

Extrait des codes dxf

1000

Chaîne ASCII (jusqu'à 255 octets) dans les données étendues

 

1001

Nom d'application enregistré (chaîne ASCII de 31 octets au maximum) pour les données étendues

 

1002

La chaîne de contrôle des données étendues peut être soit "{" soit "}".

 

1003

Nom du calque des données étendues

 

1004

Tranche d'octets (jusqu'à 127 octets) dans les données étendues

 

1005

Identificateur d'entité dans les données étendues ; chaîne de 16 chiffres hexadécimaux au maximum

 

1010

Point dans les données étendues

 

DXF: valeur X (suivie par les groupes 1020 et 1030)

 

APP: point 3D

 

1020, 1030

DXF : valeurs Y et Z d'un point

 

1011

Positionnement du système général en 3D dans les données étendues

 

DXF: valeur X (suivie par les groupes 1021 et 1031)

 

APP: point 3D

 

1021, 1031

DXF : valeurs Y et Z d'un positionnement du système général

 

1012

Déplacement du système général en 3D dans les données étendues

 

DXF: valeur X (suivie par les groupes 1022 et 1032)

 

APP: vecteur 3D

 

1022, 1032

DXF : valeurs Y et Z du premier coin (dans le SCG)

 

1013

Direction du système général en 3D dans les données étendues

 

valeur X (suivie par les groupes 1022 et 1032)

 

APP: vecteur 3D

 

1023, 1033

DXF : valeurs Y et Z d'une direction dans l'espace général

 

1040

Valeur en virgule flottante en double précision dans les données étendues

 

1041

Valeur de la distance dans les données étendues

 

1042

Facteur d'échelle dans les données étendues

 

1070

Entier signé sur 16 bits dans les données étendues

 

1071

Entier long signé sur 32 bits dans les données étendues

 

@+

[GEGEMATIC]

Merci de ton attention,

mais je ne cherche pas à écrire des Xdatas, mais bien un Xrecord dans un dictionnaire.

Ce que j'ai cité comme liste est extrait d'un Xrecord de Covadis sur un obstacle.

Sigecom m'a donné la solution, en VBA, les codes supérieurs à 369 passent tranquiles.

Le lisp intègre lui un controle.

il me reste à interfacer ma routine VBA avec le lisp, et là c'est la galère, toujours a cause de ces maudits types que VBA recrache, alors que nous, en lisp, on s'en fout !!

A+

Gégé

[Patrick_35]

Je n'ai pas trop l'habitude avec les dictionnaires, mais voici un exemple repris depuis l'aide sur dictadd

 

(setq dict (entmakex (list (cons 0 "DICTIONARY") (cons 100 "AcDbDictionary"))))
(setq dict (dictadd (namedobjdict) "Mon_Dictionnaire" dict))
(setq data (list (cons 0 "XRECORD") (cons 100 "AcDbXrecord") (cons [b][surligneur]410[/surligneur][/b] "Un Test")))
(setq pers (entmakex data))

 

Si ça ne convient pas, donne toujours la solution vba afin que j'essaye de la traduire en vlisp

 

@+

[GEGEMATIC]

Je n'ai pas trop l'habitude avec les dictionnaires, mais voici un exemple repris depuis l'aide sur dictadd

 

En fait, j'ai utilisé le même type de code, mais en visual lisp, il y a un controle qui fait que le code de groupe est limité à 369:

Cette limitation n'existe pas en VBA

 

Pour contourner ce problèeme, j'ai donc fait une commande en VBA qui comunique avec le lisp grace à VLAX.CLS

 

Il reste un petit bug sur le test d'existence du dictionnaire, mais Sigecom ou matthieu vont bien me régler ça ...

En tout cas, avec ce "kit", les visualispiens peuvent écrire des Xrecord avec les codes qu'ils veulent :

Le kit est en deux parties, une VBA, et une lisp ...

 

La partie VBA :

 'les routine suivantes doivent être placées dans le module Thisdrawing de VLAX.DVB
'ou être dans un projet contenant la classe VLAX de Franck Ockendo
'Routine pour créer un dictionnaire dictName s'il n'existe pas,
'et lui écrire un xrecord XrcdName

Sub addDictionnary(ByVal dictName As String, ByVal XrcdName As String, ByVal arrayDataType, ByVal arrayDataValue)

Dim dict As AcadDictionary
Set dict = ThisDrawing.Dictionaries.Item(dictName)

If IsNull(dict) Then
Set dict = ThisDrawing.Dictionaries.Add(dictName)
End If

Set record = dict.AddXRecord(XrcdName)
record.SetXRecordData arrayDataType, arrayDataValue
End Sub



'Routine appellée par la commande lisp
Sub vlaxWriteDicXrecord()

'Creation d'une instance VLAX pour discussion VBA - VLISP
Dim VlaEvaluator As VLAX
Set VlaEvaluator = New VLAX


' Assumes your symbol is named Vba-VlaxArrayType
Set VlaEvaluator = Nothing

Dim obj As VLAX, lspArray, lspArrayValue
Set obj = New VLAX

lspArrayType = obj.GetLispSymbol("Vba-VlaxArrayType")

lspArrayValue = obj.GetLispSymbol("Vba-VlaxArrayValue")

lspDictName = obj.GetLispSymbol("Vba-VlaxDictName")

lspXrcdName = obj.GetLispSymbol("Vba-VlaxXrcdName")


'addDictionnary "nom_de_dict", "nom_de_xrecord", lspArrayType, lspArrayValue
addDictionnary lspDictName, lspXrcdName, lspArrayType, lspArrayValue

End Sub

 

LA PARTIE LISP

 

;;routine lisp appellant le programme VBA pour pouvoir créer un Xrecod avec un code supérieur à 369
(defun c:try ()
(setq Vba-VlaxDictName "Nom_de_dictionaire")

(setq Vba-VlaxXrcdName "Nom_de_Xrecord_2")

(setq Dtype '(1040 1040 1005))
(setq arraySpace (vlax-make-safearray  vlax-vbInteger '(0 . 2) ) )
(setq Vba-VlaxArrayType (vlax-safearray-fill arraySpace Dtype))
(setq dValue '(99.99 99.99 "Une chaine"))
(setq arraySpace (vlax-make-safearray  vlax-vbvariant '(0 . 2) ) )
(setq Vba-VlaxArrayValue (vlax-safearray-fill arraySpace dValue))
 (vl-vbarun "vlaxWriteDicXrecord")
)

[Patrick_35]

Salut

voici donc une version en vlisp avec le bug corrigé

 

; Les définitions globales
(setq Vba-VlaxDictName "Nom_de_dictionaire")
(setq Vba-VlaxXrcdName "Nom_de_Xrecord_2")
(setq Dtype '(1040 1040 1005))
(setq Dvalue '(99.99 99.99 "Une chaine"))

; Plus besoin de recalibrer les tableaux. Maintenant c'est automatique :)
(setq arraySpace (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length Dtype)))))
(setq Vba-VlaxArrayType (vlax-safearray-fill arraySpace Dtype))
(setq arraySpace (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length Dvalue)))))
(setq Vba-VlaxArrayValue (vlax-safearray-fill arraySpace Dvalue))

; Traduction de la partie Vba
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(if (vl-catch-all-error-p (setq dict (vl-catch-all-apply 'vla-item  (list (vla-get-dictionaries doc) vba-VlaxDictName))))
 (setq dict (vla-add (vla-get-dictionaries doc) vba-VlaxDictName))
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item  (list dict Vba-VlaxXrcdName)))
 (progn
   (setq record (vla-AddXRecord dict Vba-VlaxXrcdName))
   (vla-SetXRecordData record Vba-VlaxArrayType Vba-VlaxArrayValue)
 )
 (princ (strcat "\nL'Xrecord" Vba-VlaxXrcdName " existe déjà"))
)

 

Mais tu peux aussi regrouper les variables Dtype et Dvalue en une seule de cette manière pour que cela soit plus clair (a mon avis)

(setq data (list (cons 1040 99.99) (cons 1040 99.99) (cons 1005 "Une chaine")))

Ou encore

(setq data '((1040 . 99.99) (1040 . 99.99) (1005 . "Une chaine")))

 

Et donc la partie du code qui change pour formater les tableaux

(setq arraySpace (vlax-make-safearray vlax-vbInteger (cons 0 (1- (length data)))))
(setq Vba-VlaxArrayType (vlax-safearray-fill arraySpace (mapcar 'car data)))
(setq arraySpace (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length data)))))
(setq Vba-VlaxArrayValue (vlax-safearray-fill arraySpace (mapcar 'cdr data)))

 

@+

[GEGEMATIC]

Très bien, c'est nettement plus pratique comme ça ...

j'avais oublié que les vla- se comportent comme le VBA, et que c'est la commande propre au lisp dictadd qui est verrouillée.

merci,

A+

Gégé

 

[GEGEMATIC]

Donc je reposte ici la version complète.

comme je le dit dans le commentaire, cette routine est largement préférable à dictadd.

 

 
;;**************************************************************************
;;§/dictionaries/creation d'un dictionaire et d'un xrecord en utilisant simplement le lisp / DictName XrcdName datalist 
;;n'est pas limité a 369 pour le code de groupe, comme dictadd l'est
;;donc à préférer à dictadd, car en plus, la syntaxe est plus claire.
;;teste l'existence du dictionnaire et de l'Xrecord, ne les écrase pas
;;avec l'aide de Patrick_35 http://www.cadxp.com/sujetXForum-16533.htm
;;exemple d'utilisation:
;; (pw_write_dict_xrecord "Nom_de_dictionaire" "Nom_de_Xrecord" '((1040 . 99.99) (1040 . 99.99) (1005 . "Une chaine")))

(defun pw_write_dict_xrecord
      (DictName XrcdName datalist / dict doc arraySpace ArrayType ArrayValue record)


;; Plus besoin de recalibrer les tableaux. Maintenant c'est automatique
 (setq	arraySpace
 (vlax-make-safearray
   vlax-vbInteger
   (cons 0 (1- (length datalist)))
 )
 )
 (setq	ArrayType
 (vlax-safearray-fill
   arraySpace
   (mapcar 'car datalist)
 )
 )
 (setq	arraySpace
 (vlax-make-safearray
   vlax-vbvariant
   (cons 0 (1- (length datalist)))
 )
 )
 (setq	ArrayValue
 (vlax-safearray-fill
   arraySpace
   (mapcar 'cdr datalist)
 )
 )

 ;; Traduction de la partie Vba
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (if (vl-catch-all-error-p
(setq dict (vl-catch-all-apply
	     'vla-item
	     (list (vla-get-dictionaries doc) DictName)
	   )
)
     )
   (setq dict (vla-add (vla-get-dictionaries doc) DictName))
   (princ
     (strcat "\nLe dictionaire " DictName " existe déjà")
   )

 )
 (if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list dict XrcdName))
     )
   (progn
     (setq record (vla-AddXRecord dict XrcdName))
     (vla-SetXRecordData
record
ArrayType
ArrayValue
    )
   )
   (princ
     (strcat "\nL'Xrecord " XrcdName " existe déjà")
   )
 )
)