Propriétés d'objets vers Object Data (OD de Map)

bonuscad · le 17 mai 2018

Bonjour,

Suite à la discussion avec une personne, je me suis retrouvé à écrire un petit bout de code.

Celui ci est destiné à constituer une table de donnée d'objet contenant les propriétés dudit objet.

Celui-ci est embryonnaire. Je l'ai testé sommairement, il s'avère qu'il se crash s'il y a des entités comme des Splines, des Hachures ou des Solides3D.

Le code suivant dans l'état traite TOUTES les entités dans l'espace objet.

Si quelqu'un a besoin d'un tel truc, il aura déjà une base.

Je me suis aidé de l'excellente routine de VDH-Bruno pour constituer celle-ci.

(defun make_table (tbl fldnamelist fldtypelist / )
 (ade_oddefinetab 
   (list
     (cons "Tablename" tbl)
     (cons "TableDesc" "")
     (append
       '("Columns")
       (mapcar
         '(lambda (x y / )
           (list
             (cons "ColName" x)
             (cons "ColDesc" "")
             (cons "ColType"
               (cond
                 ((eq (type y) 'REAL) "Real")
                 ((eq (type y) 'INT) "Integer")
                 ((eq (type y) 'LIST) "Point")
                 ((eq (type y) 'STR) "Character")
               )
             )
             (cons "DefaultVal"
               (cond
                 ((eq (type y) 'REAL) 0.0)
                 ((eq (type y) 'INT) 0)
                 ((eq (type y) 'LIST) "0.0,0.0,0.0")
                 ((eq (type y) 'STR) "")
               )
             )
           )
         )
         fldnamelist
         fldtypelist
       )
     )
   )
 )
)
;; (bv:property obj check-modify)                                   VDH-Bruno 
;; ---------------------------------------------------------------------------
;; Retourne la liste des propriétées de l'objet. Si check-modify est non nil, 
;; les propriétées en lecture seules sont omises.         
;; Exemples:
;;   (bv:property (vlax-ename->vla-object (car(entsel))) nil)
;;       --> Retourne la liste de toutes les propriétés consultable de l'objet. 
;;   (bv:property (vlax-ename->vla-object (car(entsel))) T)
;;       --> Retourne la liste de toutes les propriétés modifiable de l'objet. 

(defun bv:property (obj check-modify)
 (vl-sort
   (apply 'append
     (mapcar
       '(lambda (x)
         (if
           (and
             (/= x (setq x (vl-string-subst "" "VLA-GET-" x)))
             (vlax-property-available-p obj x check-modify)
           )
           (list x)
         )
       )
       (atoms-family 1)
     )
   )
   '<
 )
)
(defun C:Properties2OD ( / lst_prop pr2trans val tbl ename tmp_str)
 (vlax-for for-item
   (vla-get-modelspace
     (vla-get-activedocument (vlax-get-acad-object))
   )
   (setq lst_prop (vl-remove "COORDINATE" (bv:property for-item nil)) pr2trans nil)
   (foreach el lst_prop
     (cond
       ((vlax-property-available-p for-item (read el))
         (setq val (vlax-get for-item (read el)))
         (if (not (eq (type val) 'VLA-OBJECT))
           (setq pr2trans (cons (cons el val) pr2trans))
         )
       )
     )
   )
   (if pr2trans
     (progn
       (if (null (ade_odtabledefn (setq tbl (strcat "TBL_" (vlax-get for-item 'ObjectName)))))
         (make_table tbl (mapcar 'car pr2trans) (mapcar 'cdr pr2trans))
       )
       (ade_odaddrecord (setq ename (vlax-vla-object->ename for-item)) tbl)
       (mapcar
         '(lambda (x y)
           (ade_odsetfield
             ename
             tbl
             x
             0
             (if (eq (type y) 'LIST)
               (substr (setq tmp_str (apply 'strcat (mapcar '(lambda (i) (strcat (rtos i 2 4) ",")) (list (car y) (cadr y) (caddr y))))) 1 (1- (strlen tmp_str)))
               y
             )
           )
         )
         (mapcar 'car pr2trans)
         (mapcar 'cdr pr2trans)
       )
     )
   )
 )
 (prin1)
)

fabcad · le 17 mai 2018

Hello à tous,

Voici ma fonction proptood.lsp fonctionnant avec un dcl que j'avais réalisée et qui reste améliorable.

Fabcad

Le Rennais Métropolitain

PS : Envoyer-moi un message pour vous envoyer ma fonction car je n'arrive pas à joindre mon fichier ZIP

lili2006 · le 17 mai 2018

Bonjour à toutes et tous,

Salut fabcad,

Je serai intéressé pour jeter un œil sur ta routine,..

car je n'arrive pas à joindre mon fichier ZIP

Depuis we transfer par exemple,..

bonuscad · le 18 mai 2018

J'ai essayé de perfectionner la routine et qu'elle soit le plus générique possible.

Déjà pouvoir faire une sélection au lieu de traiter tous les objets de l'espace objet.

Si une sélection filtrée (ou non) a été faite au par avant, celle ci peut être reprise par la routine.

Pour chaque objet sélectionné différent, une boite de dialogue vous permettra de cocher les paramètres à transférer en donnée d'objet. (Un fois la table définie il n'est pas possible de changer les paramètres par la suite, à moins d'effacer la table et de recommencer pour les objets déjà traités)

Pour les objets ayant des points de définition multiple (vertex de polyligne par exemple), seul le point de départ sera visible dans le volet propriété; les autres seront stockés dans n records empilés (commande: _adeeditdata); autant d'enregistrements que de sommets.

(defun make_table (tbl fldnamelist fldtypelist / )
 (ade_oddefinetab 
   (list
     (cons "Tablename" tbl)
     (cons "TableDesc" "")
     (append
       '("Columns")
       (mapcar
         '(lambda (x y / )
           (list
             (cons "ColName" x)
             (cons "ColDesc" "")
             (cons "ColType"
               (cond
                 ((eq (type y) 'REAL) "Real")
                 ((eq (type y) 'INT) "Integer")
                 ((eq (type y) 'LIST) "Point")
                 ((eq (type y) 'STR) "Character")
               )
             )
             (cons "DefaultVal"
               (cond
                 ((eq (type y) 'REAL) 0.0)
                 ((eq (type y) 'INT) 0)
                 ((eq (type y) 'LIST) "0.0,0.0,0.0")
                 ((eq (type y) 'STR) "")
               )
             )
           )
         )
         fldnamelist
         fldtypelist
       )
     )
   )
 )
)
;; (bv:property obj check-modify)                                   VDH-Bruno 
;; ---------------------------------------------------------------------------
;; Retourne la liste des propriétées de l'objet. Si check-modify est non nil, 
;; les propriétées en lecture seules sont omises.         
;; Exemples:
;;   (bv:property (vlax-ename->vla-object (car(entsel))) nil)
;;       --> Retourne la liste de toutes les propriétés consultable de l'objet. 
;;   (bv:property (vlax-ename->vla-object (car(entsel))) T)
;;       --> Retourne la liste de toutes les propriétés modifiable de l'objet. 

(defun bv:property (obj check-modify)
 (vl-sort
   (apply 'append
     (mapcar
       '(lambda (x)
         (if
           (and
             (/= x (setq x (vl-string-subst "" "VLA-GET-" x)))
             (vlax-property-available-p obj x check-modify)
           )
           (list x)
         )
       )
       (atoms-family 1)
     )
   )
   '<
 )
)
(defun C:Properties2OD ( / doc js lst_prop pr2trans obj_name tbl tmp_file dcl_file dcl_id what_next lst_obj val ename)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (or
   (setq js (ssget "_I" '((67 . 0))))
   (setq js (ssget "_P" '((67 . 0))))
 )
 (cond
   (js
     (sssetfirst nil js)
     (initget "Existant Nouveau _Existent New")
     (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New")
       (progn (sssetfirst nil nil) (setq js (ssadd) js (ssget '((67 . 0)))))
     )
   )
   (T (setq js (ssget '((67 . 0)))))
 )
 (cond
   (js
     (vlax-for for-item (vla-get-activeselectionset doc)
       (setq lst_prop (reverse (vl-remove "COORDINATE" (bv:property for-item nil))) pr2trans nil)
       (cond
         ((null (ade_odtabledefn (setq tbl (strcat "TBL_" (setq obj_name (vlax-get for-item 'ObjectName))))))
           (setq
             tmp_file (vl-filename-mktemp "Prop2OD.dcl")
             dcl_file (open tmp_file "w")
           )
           (write-line
             (strcat "Properties2OD : dialog {
               label = \"Choix des propriétés vers " tbl "\";
                 : column {")
             dcl_file
           )
           (foreach el lst_prop
             (write-line
               (strcat
                 ": toggle {
                    label    = \""
                 el
                 "\";"
                 "mnemonic = \""
                 (substr el 1 1)
                 "\";"
                 "key      = \"q_"
                 el
                 "\";"
                 "}"
               )
               dcl_file
             )
           )
           (write-line
                   "}
                 ok_cancel_err;
               }"
             dcl_file
           )
           (close dcl_file)
           (foreach el lst_prop
             (eval (read (strcat "(setq q_" el " \"0\")")))
           )
           (setq dcl_id (load_dialog tmp_file))
           (setq what_next 2)
           (while (< 1 what_next)
             (if (not (new_dialog "Properties2OD" dcl_id)) (exit))
             (foreach el lst_prop
               (eval (read (strcat "(set_tile \"q_" el"\" q_" el ")")))
             )
             (foreach el lst_prop
               (eval (read (strcat "(action_tile \"q_" el "\" \"(setq q_" el " $value)\")")))
             )
             (action_tile "accept" "(done_dialog 1)")
             (action_tile "cancel" "(done_dialog 0)")
             (setq what_next (start_dialog))
           )
           (unload_dialog dcl_id)
           (vl-file-delete tmp_file)
           (foreach z (mapcar' (lambda (j) (strcat "q_" j)) lst_prop)
             (if (zerop (atoi (eval (read Z))))
               (setq lst_prop (vl-remove (substr z 3) lst_prop))
             )
             (eval (read (strcat "(setq " Z " nil)")))
           )
           (eval (read (strcat "(setq lst_" obj_name " " '"lst_prop" ")")))
           (setq lst_obj (cons (strcat "lst_" obj_name) lst_obj))
         )
         (T
           (setq lst_prop (reverse (mapcar 'cdar (cdaddr (ade_odtabledefn tbl)))))
           (eval (read (strcat "(setq lst_" obj_name " " '"lst_prop" ")")))
           (setq lst_obj (cons (strcat "lst_" obj_name) lst_obj))
         )
       )
       (eval (read (strcat "(setq lst_prop lst_" obj_name ")")))
       (foreach el lst_prop
         (cond
           ((vlax-property-available-p for-item (read el))
             (setq val (vlax-get for-item (read el)))
             (if (not (eq (type val) 'VLA-OBJECT))
               (setq pr2trans (cons (cons el val) pr2trans))
             )
           )
         )
       )
       (if pr2trans
         (progn
           (if (null (ade_odtabledefn tbl))
             (make_table tbl (mapcar 'car pr2trans) (mapcar 'cdr pr2trans))
           )
           (ade_odaddrecord (setq ename (vlax-vla-object->ename for-item)) tbl)
           (mapcar
             '(lambda (x y / nb ct tmp_y tmp_str)
               (setq tmp_y y)
               (if (and (eq (type y) 'LIST) (eq x "COORDINATES"))
                 (setq nb (/ (length y) (if (member obj_name '("AcDbPolyline")) 2 3)) ct -1)
                 (setq nb 1 ct -1)
               )
               (repeat nb
                 (setq tmp_str "")
                 (ade_odsetfield
                   ename
                   tbl
                   x
                   (setq ct (1+ ct))
                   (if (eq (type tmp_y) 'LIST)
                     (substr
                       (setq tmp_str
                         (apply
                           'strcat
                           (mapcar
                             '(lambda (i)
                               (strcat (rtos i 2 4) ",")
                             )
                             (list
                               (car tmp_y)
                               (cadr tmp_y)
                               (if (and (member obj_name '("AcDbPolyline")) (eq x "COORDINATES"))
                                 0.0
                                 (caddr tmp_y)
                               )
                             )
                           )
                         )
                       )
                       1
                       (1- (strlen tmp_str))
                     )
                     y
                   )
                 )
                 (setq tmp_str "")
                 (if (and (> nb 1) (< (1+ ct) nb))
                   (progn
                     (ade_odattachrecord ename (ade_odnewrecord tbl))
                     (if (and (eq (type tmp_y) 'LIST) (> (length tmp_y) 3))
                       (setq tmp_y (cddr tmp_y)) (setq tmp_y (cdddr tmp_y))
                     )
                   )
                 )
               )
             )
             (mapcar 'car pr2trans)
             (mapcar 'cdr pr2trans)
           )
         )
       )
     )
     (mapcar '(lambda (x) (eval (read (strcat "(setq " x " nil)")))) lst_obj)
   )
 )
 (prin1)
)

J'aurais une question!

Je voudrais écarter les propriétés qui lorsque je fais un dump retourne une exception. Par exemple sur un solide3D un dump me retourne ceci (est-ce pareil quelque soit la version AutoCAD?):

; Valeurs de propriétés:
; Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff71243d910>
; Centroid (RO) = (4982.02 -566.12 92.1028)
; Document (RO) = #<VLA-OBJECT IAcadDocument 00000000346e7278>
; EntityTransparency = "DuCalque"
; Handle (RO) = "220"
; HasExtensionDictionary (RO) = 0
; History = 0
; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 000000003485de38>
; Layer = "scu w"
; Linetype = "ByLayer"
; LinetypeScale = 1.0
; Lineweight = -1
; Material = "ByLayer"
; MomentOfInertia (RO) = (2.72262e+012 2.00538e+014 2.03041e+014)
; ObjectID (RO) = 113
; ObjectID32 (RO) = 113
; ObjectName (RO) = "AcDb3dSolid"
; OwnerID (RO) = 114
; OwnerID32 (RO) = 114
; PlotStyleName = "ByLayer"
; Position = Une exception s’est produite
; PrincipalDirections (RO) = (1.0 0.0 0.0 0.0 1.0 0.0 ... )
; PrincipalMoments (RO) = (6.64416e+010 6.64416e+010 5.06929e+010)
; ProductOfInertia (RO) = (-2.27723e+013 -4.20993e+011 3.70486e+012)
; RadiiOfGyration (RO) = (580.693 4983.69 5014.7)
; ShowHistory = 0
; SolidType (RO) = Une exception s’est produite
; TrueColor = #<VLA-OBJECT IAcadAcCmColor 000000003485e6d0>
; Visible = -1
; Volume (RO) = 8.07409e+006

Comment faire pour écarter ces propriétés qui retournent des exceptions (ici: Position et SolidType), car bien sûr, ça fait un bug dans la routine.

Merci de vos suggestions!

,

lecrabe · le 19 mai 2018

Hello Bruno

1) Ta routine me plait enormement ! ... MERCI Beaucoup !!

--- Je l'ai testee et validee sur AutoCAD MAP 2019 ...

2) Mais SVP je sollicite qq ameliorations fort interessantes :

****** Amelioration A ****** Special pour les Polylignes 2D/3D ******

Pour les Poly 2D (Legeres/Lourbes, Lissees ou non, Splinees on NON) et IDEM pour les 3DPoly

Au depart SVP poser un question relative aux Vertex des Polylignes 2D/3D (Point de depart, N Points de passages, Point Final - Point Depart = Point Final quand Polyligne 2D/3D close)

Voulez vous TOUS les Points de passage dans des Records OD supplementaires ??

Defaut = NON

OUI - Ce que realise actuellement ta routine !

NON ---> SEULEMENT Point Depart ET Point Final

ALORS tu crees 2 x 3 champs OD (au 1er niveau) : X1/Y1/Z1 (Point de depart) et X2/Y2/Z2 (Point final)

ATTENTION : SVP 2 x 3 champs OD Float/Real SEPARES et non pas UN SEUL champ avec les 3 Coords XYZ (X,Y,Z)

AINSI on aura directement en OD (au 1er niveau les Coords des Points Depart / Arrivee)

et donc un MAPEXPORT pourra envoyer ces Infos VITALES en SHP (ou autre format) ...

Vois tu ce que je veux dire !?

****** Amelioration B ****** Special pour les Lignes, Arcs, Splines Closes ou NON , Ellipses Closes ou Non ******

OBEIR SI POSSIBLE a la meme question et si OUI alors ...

ALORS tu crees 2 x 3 champs OD (au 1er niveau) : X1/Y1/Z1 (Point de depart) et X2/Y2/Z2 (Point final)

et non pas UN SEUL champ : StartPoint & EndPoint avec 3 Coords

ATTENTION : SVP 2 x 3 champs OD Float/Real SEPARES et non pas UN SEUL champ avec les 3 Coords XYZ (X,Y,Z)

Pour moi, l' Amelioration B est MOINS importante que l'Amelioration A !!

****** Ou alors dans le DCL proposer ... ********

Options : COORDS (O/N) Cocher / Ne pas Cocher

- Si OUI on genere N records OD supplementaires - Ce que fait la Routine ACTUELLE !

Si NON, on ne genere pas les N records OD supplementaires

Options : X1Y1Z1-X2Y2Z2 (O/N) Cocher / Ne pas Cocher

- Si OUI on genere les 6 champs OD real/float au Record ZERO (1er niveau)

Si NON, on ne genere pas les 6 champs OD Real/Float au Record ZERO (1er niveau)

============ Ou alors encore "plus simple" ... ============

Tu ne touches pas a la routine ACTUELLE !

Et tu en ecris UNE AUTRE (derivee de la 1ere) qui ne cree aucun record 1/2/N pour les Coords de chaque Vertex des Polylignes 2D/3D

MAIS MAIS qui cree et remplit 6 champs X1/Y1/Z1/X2/Y2/Z2 OD Real/Float au Record ZERO (1er niveau)

Merci d'avance, Bon WE, Bye, lecrabe

lili2006 · le 20 mai 2018

Bonjour à toutes et tous,

Du grand art, merci Bruno !!

bonuscad · le 24 mai 2018

@lecrabe

Tes désirs sont compréhensibles, mais d'une routine au départ générique tu en veux une spéciale.

Mais qui dit spécial dit forcément traitement spécial par le code, donc plus compliqué.

Ici je me suis attaché à transformer les LIST en 3 champs de REAL au lieu du POINT à l'initial. Donc par exemple le vecteur de direction NORMAL qui est une liste sera lui aussi exprimé en 3 réels

Les polylignes n'ont pas dans les propriétés les champs STARTPOINT et ENDPOINT comme une ligne, mais un champ COORDINATES. Donc impossible (ou compliqué) de générer ces propriétés de liste en point de départ et point d'arrivée en OD de façon générique.

Je te livre une avancée (avec des bugs possibles)

(defun make_table (tbl fldnamelist fldtypelist / )
 (ade_oddefinetab 
   (list
     (cons "Tablename" tbl)
     (cons "TableDesc" "")
     (append
       '("Columns")
       (mapcar
         '(lambda (x y / )
           (append
             (if (eq (type y) 'LIST)
               (mapcar
                 '(lambda (ux / )
                   (list
                     (cons "ColName" (strcat x ux))
                     (cons "ColDesc" "")
                     (cons "ColType" "Real")
                     (cons "DefaultVal" 0.0)
                   )
                 )
                 '("_X" "_Y" "_Z")
               )
               (list
                 (cons "ColName" x)
                 (cons "ColDesc" "")
                 (cons "ColType"
                   (cond
                     ((eq (type y) 'REAL) "Real")
                     ((eq (type y) 'INT) "Integer")
                     ((eq (type y) 'LIST) "Real")
                     ((eq (type y) 'STR) "Character")
                   )
                 )
                 (cons "DefaultVal"
                   (cond
                     ((eq (type y) 'REAL) 0.0)
                     ((eq (type y) 'INT) 0)
                     ((eq (type y) 'LIST) 0.0)
                     ((eq (type y) 'STR) "")
                   )
                 )
               )
             )
           )
         )
         fldnamelist
         fldtypelist
       )
     )
   )
 )
)
;; (bv:property obj check-modify)                                   VDH-Bruno 
;; ---------------------------------------------------------------------------
;; Retourne la liste des propriétées de l'objet. Si check-modify est non nil, 
;; les propriétées en lecture seules sont omises.         
;; Exemples:
;;   (bv:property (vlax-ename->vla-object (car(entsel))) nil)
;;       --> Retourne la liste de toutes les propriétés consultable de l'objet. 
;;   (bv:property (vlax-ename->vla-object (car(entsel))) T)
;;       --> Retourne la liste de toutes les propriétés modifiable de l'objet. 

(defun bv:property (obj check-modify)
 (vl-sort
   (apply 'append
     (mapcar
       '(lambda (x)
         (if
           (and
             (/= x (setq x (vl-string-subst "" "VLA-GET-" x)))
             (vlax-property-available-p obj x check-modify)
           )
           (list x)
         )
       )
       (atoms-family 1)
     )
   )
   '<
 )
)
(defun C:Properties2OD ( / doc js lst_prop pr2trans obj_name tbl tmp_file dcl_file dcl_id what_next lst_obj val ename flag numrec cnt)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (or
   (setq js (ssget "_I" '((67 . 0))))
   (setq js (ssget "_P" '((67 . 0))))
 )
 (cond
   (js
     (sssetfirst nil js)
     (initget "Existant Nouveau _Existent New")
     (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New")
       (progn (sssetfirst nil nil) (setq js (ssadd) js (ssget '((67 . 0)))))
     )
   )
   (T (setq js (ssget '((67 . 0)))))
 )
 (cond
   (js
     (vlax-for for-item (vla-get-activeselectionset doc)
       (setq lst_prop (reverse (vl-remove "COORDINATE" (bv:property for-item nil))) pr2trans nil)
       (cond
         ((null (ade_odtabledefn (setq tbl (strcat "TBL_" (setq obj_name (vlax-get for-item 'ObjectName))))))
           (setq
             tmp_file (vl-filename-mktemp "Prop2OD.dcl")
             dcl_file (open tmp_file "w")
           )
           (write-line
             (strcat "Properties2OD : dialog {
               label = \"Choix des propriétés vers " tbl "\";
                 : column {")
             dcl_file
           )
           (foreach el lst_prop
             (write-line
               (strcat
                 ": toggle {
                    label    = \""
                 el
                 "\";"
                 "mnemonic = \""
                 (substr el 1 1)
                 "\";"
                 "key      = \"q_"
                 el
                 "\";"
                 "}"
               )
               dcl_file
             )
           )
           (write-line
                   "}
                 ok_cancel_err;
               }"
             dcl_file
           )
           (close dcl_file)
           (foreach el lst_prop
             (eval (read (strcat "(setq q_" el " \"0\")")))
           )
           (setq dcl_id (load_dialog tmp_file))
           (setq what_next 2)
           (while (< 1 what_next)
             (if (not (new_dialog "Properties2OD" dcl_id)) (exit))
             (foreach el lst_prop
               (eval (read (strcat "(set_tile \"q_" el"\" q_" el ")")))
             )
             (foreach el lst_prop
               (eval (read (strcat "(action_tile \"q_" el "\" \"(setq q_" el " $value)\")")))
             )
             (action_tile "accept" "(done_dialog 1)")
             (action_tile "cancel" "(done_dialog 0)")
             (setq what_next (start_dialog))
           )
           (unload_dialog dcl_id)
           (vl-file-delete tmp_file)
           (foreach z (mapcar' (lambda (j) (strcat "q_" j)) lst_prop)
             (if (zerop (atoi (eval (read Z))))
               (setq lst_prop (vl-remove (substr z 3) lst_prop))
             )
             (eval (read (strcat "(setq " z " nil)")))
           )
           (eval (read (strcat "(setq lst_" obj_name " " '"lst_prop" ")")))
           (setq lst_obj (cons (strcat "lst_" obj_name) lst_obj))
           (eval (read (strcat "(setq lst_prop lst_" obj_name ")")))
         )
         (T
           (setq lst_prop (reverse (mapcar 'cdar (cdaddr (ade_odtabledefn tbl)))))
           (eval (read (strcat "(setq lst_" obj_name " " '"lst_prop" ")")))
           (setq lst_obj (cons (strcat "lst_" obj_name) lst_obj))
           (mapcar '(lambda (x) (if (wcmatch x "*_[YZ]") (setq lst_prop (vl-remove x lst_prop)))) lst_prop)
           (mapcar '(lambda (x) (if (wcmatch x "*_X") (setq lst_prop (subst (vl-string-right-trim "_X" x) x lst_prop)))) lst_prop)
         )
       )
       (foreach el lst_prop
         (cond
           ((vlax-property-available-p for-item (read el))
             (setq val (vlax-get for-item (read el)))
             (if (not (eq (type val) 'VLA-OBJECT))
               (setq pr2trans (cons (cons el val) pr2trans))
             )
           )
         )
       )
       (if pr2trans
         (progn
           (if (setq flag (null (ade_odtabledefn tbl)))
             (make_table tbl (mapcar 'car pr2trans) (mapcar 'cdr pr2trans))
           )
           (setq ename (vlax-vla-object->ename for-item))
           (if (or flag (zerop (ade_odrecordqty ename tbl)))
             (ade_odaddrecord ename tbl)
             (progn
               (setq numrec (ade_odrecordqty ename tbl))
               (cond
                 ((> numrec 1)
                   (setq cnt (1- numrec))
                   (while (not (zerop cnt))
                     (ade_oddelrecord ename tbl cnt)
                     (setq cnt (- cnt 1))
                   )
                 )
               )
             )
           )
           (mapcar
             '(lambda (x y / nb ct tmp_y)
               (setq tmp_y y)
               (if (and (eq (type y) 'LIST) (eq x "COORDINATES"))
                 (setq nb (/ (length y) (if (member obj_name '("AcDbPolyline")) 2 3)) ct -1)
                 (setq nb 1 ct -1)
               )
               (repeat nb
                 (mapcar
                   '(lambda (el val / )
                     (setq ct (1+ ct))
                     (if (listp el)
                       (mapcar
                         '(lambda (l m / )
                           (ade_odsetfield
                             ename
                             tbl
                             l
                             ct
                             m
                           )
                         )
                         el
                         val
                       )
                       (ade_odsetfield ename tbl el ct val)
                     )
                   )
                   (list
                     (if (eq (type tmp_y) 'LIST)
                       (mapcar
                         '(lambda (ux / )
                           (strcat x ux)
                         )
                         '("_X" "_Y" "_Z")
                       )
                       x
                     )
                   )
                   (list
                     (if (eq (type tmp_y) 'LIST)
                       (list
                         (car tmp_y)
                         (cadr tmp_y)
                         (if (and (member obj_name '("AcDbPolyline")) (eq x "COORDINATES"))
                           0.0
                           (caddr tmp_y)
                         )
                       )
                       y
                     )
                   )
                 )
                 (if (and (> nb 1) (< (1+ ct) nb) (eq (type tmp_y) 'LIST))
                   (if (and (member obj_name '("AcDbPolyline")) (eq x "COORDINATES"))
                     (progn (setq tmp_y (cddr tmp_y)) (ade_odaddrecord ename tbl))
                     (progn (setq tmp_y (cdddr tmp_y)) (ade_odaddrecord ename tbl))
                   )
                 )
               )
             )
             (mapcar 'car pr2trans)
             (mapcar 'cdr pr2trans)
           )
         )
       )
     )
     (mapcar '(lambda (x) (eval (read (strcat "(setq " x " nil)")))) lst_obj)
   )
 )
 (prin1)
)

bonuscad · le 2 octobre 2018

En complément de Properties2OD (ou pas), j'ai travaillé sur une routine (dont Lecrabe avait eu une version Beta)

Cette routine permet de transférer une valeur de champ d'une table source vers un champ d'une table cible.

ATTENTION, si le type de valeur de champ entre source et cible n'est pas le même et que vous choisissez de les convertir (exemple réel -> chaîne),

c'est le champ de table SOURCE qui sera converti avant la copie, et en fonction des capacités de la fonction (ade_odmodifyfield): voir l'aide car toutes les conversions ne sont pas forcément possible, pour corréler les deux types de données. NOTEZ BIEN CECI !

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq
tmp (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
(strcat "ListBox:dialog{label=\"" title "\";")
file
 )
 (if (and msg (/= msg ""))
(write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
(cond
 	((= 0 flag) "spacer;:popup_list{key=\"lst\";")
 	((= 1 flag) "spacer;:list_box{key=\"lst\";")
 	(T "spacer;:list_box{key=\"lst\";multiple_select=true;")
)
file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
(exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
"accept"
"(or (= (get_tile \"lst\") \"\")
 	(if (= 2 flag)
   	(progn
     	(foreach n (str2lst (get_tile \"lst\") \" \")
       	(setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
     	)
     	(setq choice (reverse choice))
   	)
   	(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
 	)
)
(done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)
(defun c:transfert_OD ( / js l_tab tab_source list_field_source l_field field_source tab_target list_field_target field_target in typ_source typ_target conv_value n obj tbllist)
 (setq js
(ssget
 	(list
   	(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
   	(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
 	)
)
 )
 (cond
(js
 	(setq l_tab (ade_odtablelist))
 	(while (null (setq tab_source (listbox "TABLES" "Choisir la table SOURCE" (mapcar 'cons l_tab l_tab) 1))))
 	(setq
   	list_field_source (ade_odtabledefn tab_source)
   	l_field (mapcar 'cdr (mapcar 'car (cdaddr list_field_source)))
 	)
 	(while (null (setq field_source (listbox "CHAMPS" (strcat "Choisir le champ SOURCE pour la table " tab_source) (mapcar 'cons l_field l_field) 1))))
 	(while (null (setq tab_target (listbox "TABLES" "Choisir la table CIBLE" (mapcar 'cons l_tab l_tab) 1))))
 	(setq
   	list_field_target (ade_odtabledefn tab_target)
   	l_field (mapcar 'cdr (mapcar 'car (cdaddr list_field_target)))
 	)
 	(while (null (setq field_target (listbox "CHAMPS" (strcat "Choisir le champ CIBLE pour la table " tab_target) (mapcar 'cons l_field l_field) 1))))
 	(setq in
   	(list
     	(cons tab_source field_source)
     	(cons tab_target field_target)
   	)
 	)
 	(if
   	(not
     	(eq
       	(setq typ_source (cdr (assoc "ColType" (assoc (cons "ColName" (cdar in)) (cdaddr list_field_source)))))
       	(setq typ_target (cdr (assoc "ColType" (assoc (cons "ColName" (cdadr in)) (cdaddr list_field_target)))))
     	)
   	)
   	(progn
     	(princ "\nATTENTION Le type de valeur ne correspondent pas entre source et cible!")
     	(initget 1 "Oui Non _Yes No")
     	(setq conv_value (getkword "\nOpérer la convertion du type de la valeur source vers le type de la valeur cible [Oui/Non]?: "))
     	(if (eq conv_value "Yes")
       	(ade_odmodifyfield tab_source (list "Columns" (cons (cons "ColName" field_source) (cdr (assoc (cons "ColName" field_target) (cdaddr list_field_target))))))
       	(exit)
     	)
   	)
 	)
 	(repeat (setq n (sslength js))
   	(setq obj (ssname js (setq n (1- n))))
   	(setq tbllist (ade_odgettables obj))
   	(cond
     	(tbllist
       	(foreach tbl (mapcar 'car in)
         	(cond
           	((not (member tbl tbllist))
             	(ssdel obj js)
           	)
         	)
       	)
     	)
     	(T (ssdel obj js))
   	)
 	)
)
 )
 (cond
(js
 	(repeat (setq n (sslength js))
   	(setq obj (ssname js (setq n (1- n))))
   	(ade_odsetfield obj
     	(car (nth 1 in))
     	(cdr (nth 1 in))
     	0
     	(ade_odgetfield obj
       	(car (nth 0 in))
       	(cdr (nth 0 in))
       	0
     	)
   	)
 	)
)
 )
 (sssetfirst nil js)
 (princ (strcat "\n" (itoa (sslength js)) " entités ont subit des transferts d'OD de " (car (nth 0 in)) " vers " (car (nth 1 in))))
 (prin1)
)

lecrabe · le 7 octobre 2018

Hello Bruno

MERCI tu es le Maitre Jedi des ODs (avec Olivier) !

Humour : en plus tu "sevis" partout !

https://forums.autodesk.com/t5/autocad-map-3d-forum/send-polyline-layer-name-information-to-the-object-data-exactly/td-p/8299631

Bon Dimanche, Bye, lecrabe

Connexion

Propriétés d'objets vers Object Data (OD de Map)

Messages recommandés

bonuscad

fabcad

lili2006

bonuscad

lecrabe

lili2006

bonuscad

bonuscad

lecrabe

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante