Le portail francophone de la géomatique

(defun str2listpt (str / nw_str x_pt y_pt z_pt)
  (setq nw_str
    (vl-list->string
      (vl-remove-if
        '(lambda (x)
          (not (member x '(32 46 48 49 50 51 52 53 54 55 56 57)))
        )
        (vl-string->list str)
      )
    )
    x_pt (read nw_str)
    nw_str (substr nw_str (+ 2 (vl-string-position 32 nw_str)))
    y_pt (read nw_str)
    nw_str (substr nw_str (+ 2 (vl-string-position 32 nw_str)))
    z_pt (read nw_str)
  )
  (list x_pt y_pt z_pt)
)
(defun c:text2OD ( / js nam_tabl desc_tabl name_od desc_od key_od tbldef n ent_js sel_value dxf_ent str_text value_od)
  (setq js (ssget))
  (cond
    (js
      (setq nam_tabl (getstring "\nEntre le nom de la table: "))
      (if (not (member nam_tabl (ade_odtablelist)))
        (progn
          (setq
            desc_tabl (getstring T "\nDescription de la table: ")
            name_od (getstring "\nNom de la donnée d'objet: ")
            desc_od (getstring T "\nDescrition de la donnée d'objet: ")
          )
          (initget 1 "Entier Caractère Point Réel _Integer Character Point Real")
          (setq key_od (getkword "\nType de valeur de la donnée d'objet [Entier/Caractère/Point/Réel]?: "))
          (ade_oddefinetab
            (list
              (cons "tablename" nam_tabl)
              (cons "tabledesc" desc_tabl)
              (list "columns"
                (list
                  (cons "ColName" name_od)
                  (cons "ColDesc" desc_od)
                  (cons "ColType" key_od)
                  (cond
                    ((eq key_od "Integer") (cons "DefaultVal" 0))
                    ((eq key_od "Character") (cons "DefaultVal" ""))
                    ((eq key_od "Point") (cons "DefaultVal" "0,0,0"))
                    ((eq key_od "Real") (cons "DefaultVal" 0.0))
                  )
                )
              )
            )
          )
        )
      )
      (setq tbldef (ade_odtabledefn nam_tabl))
      (repeat (setq n (sslength js))
        (ade_odaddrecord (setq ent_js (ssname js (setq n (1- n)))) nam_tabl)
        (command "_.zoom" "_object" ent_js "")
        (while (null dxf_ent)
          (setq sel_value (nentsel "\nSelectionnez un objet Texte,Multitexte ou Attribut: "))
          (cond
            ((and sel_value (member (cdr (assoc 0 (setq dxf_ent (entget (car sel_value))))) '("TEXT" "MTEXT" "ATTRIB")))
              (setq str_text (cdr (assoc 1 dxf_ent)))
              (cond
                ((eq key_od "Integer") (setq value_od (if (eq (type (read str_text)) 'INT) (fix (read str_text)) nil)))
                ((eq key_od "Character") (setq value_od str_text))
                ((eq key_od "Point") (setq value_od (if (eq (type (str2listpt str_text)) 'LIST) str_text nil)))
                ((eq key_od "Real") (setq value_od (if (eq (type (read str_text)) 'REAL) (float (read str_text)) nil)))
                (T (setq value_od nil))
              )
            )
            (T (princ "\nPas de chaine de caractère à récupérer!")(setq dxf_ent nil))
          )
        )
        (if value_od (ade_odsetfield ent_js nam_tabl name_od 0 value_od) (princ "\nLa valeur ne convient pas!"))
        (setq dxf_ent nil)
      )
    )
  )
  (prin1)
)