Хэ-records

Хэ-records · 19.12.2005, 08:39

Привет всем!
Никогда еще не приходилось работать с х-записями
Помогите пожалуйста разобраться?
Задача такова:
Необходимо создать несколько словарей из списка вида (где "записи" - содержание словаря):
(setq datalist '(("имя словаря №1" "запись 11" "запись 12" .... "запись 1N") ;- 1и словарь
("имя словаря №2" "запись 21" "запись 22" .... "запись 2N") ;- 2и словарь
("имя словаря №3" "запись 31" "запись 32" .... "запись 3N") ;- 3и словарь
)
)
Если в общей базе словарь с таким именем уже есть то его надо полностью заменить словарем из списка

datalist.
И обратная функция которая из существующих словарей формирует список datalist.
Хотя обратную я сам может сделаю.

fixo · 19.12.2005, 09:41

Смотри здесь:

http://members.tripod.com/~vnestr/SaveData.lsp

Кулик Алексей aka kpblc · 19.12.2005, 10:13

> Fatty : А можно оттуда опубликовать код? У меня чего-то не получилось достучаться

fixo · 19.12.2005, 11:01

Цитата:

Сообщение от kpblc

> Fatty : А можно оттуда опубликовать код? У меня чего-то не получилось достучаться

Пожалуйста

Код:

[Выделить все]

;; SaveData.lsp
;; Save *any* variable with the DWG
;;    Written  Nov 30, 1997.
;;    Updated for r15 and xdict-* functions added Dec 7, 1999.
;;
;;*************************************************************
;;   Copyright Vladimir Nesterovsky 1997, All Rights Reserved
;;
;; You may use, copy and distribute this program *unmodified*
;; for any non-commercial, non-profit purpose and without
;; charging any fee, if you keep this notice in its entirety
;;       in all copies and in all your derived works.
;;
;; This program is provided "AS IS" and has absolutely
;;  no warranty of any kind. Use it at your own risk.
;;
;; You're welcome to contact me about the possibility to use
;; this program commercially, and also with any comments and
;;        requests at vnestr@netvision.net.il,
;;              http://vnestr.tripod.com/
;;*************************************************************
;;
;; This file contains functions that will let you save any
;; list of data without dotted pairs inside dictionary with
;;      (dict-put "mydict" "mykey" "myval")
;; and retrieve it later with
;;      (dict-get "mydict" "mykey")
;; OR store it in xdictionary under some entity with
;;      (xdict-put ename "mykey" "myval")
;; and retrieve it similarly with
;;      (xdict-get ename "mykey")
;; xdictionary only allows for one key to hold the data,
;; regular dictionaries don't have this restriction, so you
;; may use any number of keys inside your dictionary
;;*************************************************************
;;
;; BEWARE that these functions use recursion in encoding / decoding
;; so for very long and complex lists they can use up all available
;; AutoLISP stack space and cause "AutoLISP stack overflow" error.
;;
;; look into http://vnestr.tripod.com/SaveData.txt !


;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
;;;;;;; The two working functions: ;;;;;;;
;;;;;;;____________________________;;;;;;;
;;
;;Sample use:
;; (dict-put "mydict" "mykey" '(1 (2 ("3" (44.4) (5.5 6.6 7.7) 8)) 999999))
;; (dict-get "mydict" "mykey")
;;POSSIBLE IMPROVEMENTS:
;; implement dict-append ( APPEND PREPEND )


;; Get A [Key] Value From Dictionary [Name]
(cond
 ((member (substr (getvar "acadver") 1 2)  '( "13" "14"))
  (defun dict-get ( name key ) ;; name and key As strings
    (x-relist                  ;; decode the data!
      (cdr (member '(100 . "AcDbXrecord")
        (dict-getrawdata name key))))))
 ((= "15" (substr (getvar "acadver") 1 2))
  (defun dict-get ( name key ) ;; name and key As strings
    (x-relist                  ;; decode the data!
      (cddr (member '(100 . "AcDbXrecord") ;; new (280) code group in r15
        (dict-getrawdata name key)))))))

;; Put A [Val]ue Into [Name] Dictionary Under [Key]
;; Dictionary is created automatically if was not existing
;; three arguments As strings
;; NAME may also be an entity name of some existing dictionary
(defun dict-put ( name key val )
  (dict-clear name key) ;;  clear the old value under this Key
  (dictadd
    (setq name (cond ((dict-name name)) ((dict-new name)) ))
    key
    (entmakex
      (cons '(0 . "XRECORD")
        (cons '(100 . "AcDbXrecord")
          (x-enlist val)))) ) ;; encode the data!
  name )  ;; return the dictionary altered


;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;
;;        XDICTIONARY SUPPORT
;;  two more similar functions to use:
;;;;;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~;;;;;;;

(defun xdict-put ( ename key val )
 (addxdict ename (dict-put nil key val)))

(defun xdict-get ( ename key )
 (dict-get (cdr (assoc 360 (entget ename))) key))


;;;;;;; utility functions in use ;;;;;;;

;; a general utility -- pop first value off the list
(defun pop (a / b)
  (setq b (eval a))
  (set a (cdr b))
  (car b))

;; general functions re/en-list, just to try things out
;; re-list can be also used in decoding xdata
(defun re-list ( lst / tok )
 (re-list-aux))

(defun re-list-aux()
 (cond
  ((atom lst) lst)
  ((/= "}" (setq tok (pop 'lst)))
   (cons (if (= "{" tok) (re-list-aux) tok)
         (re-list-aux)))))

(defun en-list ( lst )
  (cond
   ((null lst) lst)
   ((atom lst) (list lst))
   ((cons "{"    ;; add the markers around the list!
      (reverse
        (cons "}"
          (reverse
            (apply 'append  ;; open the lists
              (mapcar 'en-list lst) ;; recursion!
      ))))))))

;; a special encoding function for Xrecords to be used in dictionaries
(defun x-enlist ( lst )  ;; encode!
  (cond
   ((null lst) lst)
   ((atom lst)           ;; automatic code groups
     (cond
      ((= 'REAL (type lst))
        (list (cons 40 lst)))
      ((= 'INT (type lst))
       (if               ;; special handling of long integers
         (< -32768 lst 32767)
          (list (cons 70 lst))
          (list (cons 41 (float lst)))))
      ((= 'STR (type lst))
        (list (cons  1 lst)))
      (T nil)))
   ((and (cdr lst) (atom (cdr lst)))
      (list lst))      ;; pass dotted pair AS IS -- must be valid!!
   ((and (= (length lst) 3)
         (apply 'and (mapcar 'numberp lst)))
     (list (cons 10 lst)))
   ((cons '(2 . "{")
     (reverse
      (cons '(2 . "}")
       (reverse
        (apply 'append
         (mapcar 'x-enlist lst) ))))))))


(defun x-relist ( lst / tok )  ;; decode it!
 (car (x-relist-aux)))

(defun x-relist-aux()
 (cond
  ((null lst) nil)
  ((not (equal '(2 . "}") (setq tok (pop 'lst))))
   (cons (if (equal '(2 . "{") tok)
           (x-relist-aux)
           (cond      ;; special processing of TOK to recover
             ((= 41 (car tok)) ;; long integers back
              (fix (cdr tok)))
             (T
              (cdr tok)))
           )
         (x-relist-aux)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; dictionary functions for R14
;; POSSIBLE IMPROVEMENTS: support trees of dictionaries
;;      now: all custom dictionaries are under the Root.
;;
;; Get Dictionary Object Name From Root Dictionary
(defun dict-name ( name ) ;; name As string or ename of exist dict
 (cond
   ( (= 'STR (type name))
     (cdr (assoc -1 (dictsearch (namedobjdict) name))))
   ( (and (= 'ENAME (type name))
          (= "AcDbDictionary" (cdr (assoc 100 (entget name)))) )
     name )))

;; Remove Dictionary [Name] From Root Dictionary
(defun dict-remove ( name / d0 ) ;; name As string
  (if (dictsearch (Setq d0 (namedobjdict)) name)
    (dictremove d0 name))
  )

;; Make A New Empty Dictionary and put into into Root; Reset Existing.
(defun dict-new ( name / d0 ) ;; name As string
  (cond
    ( (/= 'STR (type name))
      (dict-new-orphan) )
    ('t
      (if (dictsearch (Setq d0 (namedobjdict)) name)
        (dictremove d0 name))
      (dictadd d0 name
        (dict-new-orphan) ))
    ))

;; (dict-new-ex parent name) parent := ROOT | ename (dict or reg for xdict)

(defun dict-new-orphan ()
  (entmakex '((0 . "DICTIONARY")(100 . "AcDbDictionary"))))

;; List A Dictionary As Pairs {Name . Object Name}
(defun dict-list ( dname / d nl ) ;; dname As object name or string else ROOT
  (cond
    ((and (Setq d (cond
                    ((= 'ENAME (type dname))
                      dname)
                    ((= 'STR (type dname))
                      (dict-name dname))
                    (T (namedobjdict))))
          (Setq d (entget d)))
      (while (setq d (member (assoc 3 d) d))
        (if (or (= 350 (caadr d)) ;; regular dict
                (= 360 (caadr d)) ;; extension dict
                )
          (setq nl (cons (cons (cdar d) (cdadr d)) nl)))
        (setq d (cdr d)))
      (reverse nl))))

;; Get Raw [Name] Dictionary Data for [Key]
(defun dict-getrawdata ( name key / d ) ;; name and key As strings
  (cond
    ((='STR (type name))
      (if (setq d (dict-name name))
        (dictsearch d key)))
    ((='ENAME (type name))
      (dictsearch name key) )
    ( (dictsearch (namedobjdict) key) )))

;; Clear The [Key] From Dictionary [Name]
(defun dict-clear ( name key / d) ;; name and key As strings
  (if (setq d (dict-name name))
    (dictremove d key)))

;; add xdictionary DK into the carrier entity data ECD
;; you can use it like (addxdict _entname_ (dict-put nil _key_ _val_))
;; eg. (addxdict (tblobjname"layer""0") (dict-put nil "MYDATA" 1.23))
;; to associate some data with layer "0".
;; you'll retrieve this data later with
;;   (setq d (cdr(assoc 360 (entget (tblobjname "layer""0")))))
;; and
;;   (dict-get d _key_)
(defun addxdict (ECD DK / TT)
 (cond
   ( (= 'ENAME (type ecd))
     (addxdict (entget ecd) dk) )
   ( (or (atom ecd) (atom (car ecd)) (not (atom (cdar ecd))))
     nil )
   ( (= 'STR (type dk))
     (addxdict ecd (dictsearch (namedobjdict) dk)) )
   ( (/= 'ENAME (type dk))
     nil )
   ( (/= "AcDbDictionary" (cdr (assoc 100 (entget dk))))
     nil )
   ( (assoc 102 ecd)
   ;; there already is an extension dictionary attached to this entity
   ;; can I prepend another dictionary into it?? No! :-(
     (while (/= (caar ecd) 102)
       (setq tt  (cons (car ecd) tt)
             ecd (cdr  ecd)))
     (setq tt  (cons (car ecd) tt) ;; {
           ecd (cdr ecd))
     (while (/= 102 (caar ecd))    ;; }
       (setq ecd (cdr ecd)))

     (setq ecd (cons (cons 360 dk) ecd) )
     (while tt
       (setq ecd (cons (car tt) ecd)
             tt  (cdr tt)))
     (entmod ecd))
   ( (assoc 100 ecd)
     (while (/= (caar ecd) 100)
       (setq tt (cons (car ecd) tt)
            ecd (cdr  ecd)))
     (setq ecd
       (cons (quote (102 . "{ACAD_XDICTIONARY"))
         (cons (cons 360 dk)
           (cons (quote (102 . "}")) ecd))))
     (while tt
       (setq ecd (cons (car tt) ecd)
             tt  (cdr tt)))
     (entmod ecd))
 ))

;; EOF SaveData.lsp

VVA · 19.12.2005, 11:04

Можно так

Код:

[Выделить все]

(setq datalist '(("DICT1" "запись 11" "запись 12" "запись 1N") ("DICT2" "запись 21" "запись 22" "запись 2N") ("DICT3" "запись 31" "запись 32" "запись 3N")))
;;;Заносим данные
(foreach dict datalist
  (vlax-ldata-put (car dict) "MyKEY" (cdr dict))
)  
;;;Читаем данные
(foreach dict datalist
  (princ (strcat "\nДанные словаря " (car dict) "="))
  (princ (vlax-ldata-get (car dict) "MyKEY"))
)

fixo · 19.12.2005, 11:42

Цитата:

Сообщение от VVA

Можно так

Код:

[Выделить все]

(setq datalist '(("DICT1" "запись 11" "запись 12" "запись 1N") ("DICT2" "запись 21" "запись 22" "запись 2N") ("DICT3" "запись 31" "запись 32" "запись 3N")))
;;;Заносим данные
(foreach dict datalist
  (vlax-ldata-put (car dict) "MyKEY" (cdr dict))
)  
;;;Читаем данные
(foreach dict datalist
  (princ (strcat "\nДанные словаря " (car dict) "="))
  (princ (vlax-ldata-get (car dict) "MyKEY"))
)

Все правильно, только не знаю по какой причине

R. Bell и Tony Tanzillo предостерегают от ипользования LDATA из-за
последующих возможных глюков

VVA · 19.12.2005, 12:32

Может потому что

Код:

[Выделить все]

;;    Written  Nov 30, 1997. 
;;    Updated for r15 and xdict-* functions added Dec 7, 1999.

У меня 3 года нормально работают ф-ции на 2002, 2004, 2005 Акаде

fixo · 19.12.2005, 14:28

Пример для одного субсписка, переделай исходя из
своих данных:

Код:

[Выделить все]

(defun C:xrd (/ acsp adoc append_data dicts
	      first_dict return_data type_list
	      xdt xrecord_data xrecord_obj
	      xrecord_track xrecord_type)
  
  (vl-load-com)
  (or adoc
      (setq adoc (vla-get-activedocument
		   (vlax-get-acad-object)
		 )
      )
  )
  
(if
(setq append_data '("FIRST_DICTIONARY_NAME" ; имя словаря
		    "FIRST_XRECORD_TRACK" ; имя записи
		    "запись 11" "запись 12"  "запись 1N"))
(progn
(setq dicts (vla-get-dictionaries adoc))    
(if (vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda ()
(vla-item dicts (car append_data)))))); если еще не создан такой словарь
(setq first_dict (vla-add dicts (car append_data)))
(setq first_dict (vla-item dicts (car append_data))))

(setq xrecord_track (cadr append_data))

(setq xrecord_type
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbinteger (cons 1  (length (cddr append_data))))
(foreach i (cddr append_data)
  (setq type_list (cons 1000 type_list)))))
      
(setq xrecord_data
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbvariant (cons 1 (length (cddr append_data))))
(cddr append_data)))
       
(vla-addxrecord first_dict xrecord_track)
(setq xrecord_obj (vla-getobject first_dict xrecord_track))
(vla-setxrecorddata xrecord_obj xrecord_type xrecord_data)

; Проверка на создание Х-записи :
    
(vla-getxrecorddata (vla-item  first_dict xrecord_track) 'xtp 'xdt)
(setq return_data (mapcar 'vlax-variant-value
			      (vlax-safearray->list  xdt)))
(alert (vl-princ-to-string return_data))
(mapcar (function (lambda (x)
		    (if (not (vlax-object-released-p x))
		      (vlax-release-object x))))
	(list dicts first_dict xrecord_obj))))
(princ)
)

Fatty

~'J'~

Chapay · 19.12.2005, 14:28

Спасибо всем помогли! сделал через
vlax-idata-get/put, Скажите еще можна ли выдрать из общей базы словарей - словари с определенным ключем. тк vlax-idata-get работает только с имнем словаря.
я не знаю сколько и с какими именами будет моих словарей поэтому нада выдирать по своему уникальному ключу или как?
можно наверно еще так:
записать
(foreach dict list_dic
(vlax-ldata-put (strcat "$mydic$" (car dict)) "MyKEY" (cdr dict))
)

чуть не написал $mydick$ )))
а забирать: читать все через (entget (namedobjdict)) искать среди них с имнем на "$mydic$"
а потом только через vlax-ldata-get по этим именам забирать свои?
или создавать паралельно свой словарь
со своим уникальным имнем который содержит имена моих словарей или содержит сами эти словари?
и может ли такой словарь занимать более 16 с гаком кб?

fixo · 19.12.2005, 15:03

На всякий случай если кому-то это будет интересно,
для общего списка:

Код:

[Выделить все]

(defun C:xrd (/ acsp adoc append_data dicts
	      first_dict return_data type_list
	      xdt xrecord_data xrecord_obj
	      xrecord_track xrecord_type)
  
  (vl-load-com)
  (or adoc
      (setq adoc (vla-get-activedocument
		   (vlax-get-acad-object)
		 )
      )
  )
  
(if
(setq append_data '("MY_DICTIONARY_NAME"  ; dictionary name
		     "XRECORD_TRACK_NAME" ; xrecord name
		    ("XRECORD_TRACK #1" "data 11" "data 12"  "data 1NN")
		    ("XRECORD_TRACK #2" "data 21" "data 22"  "data 2NN")
		    ("XRECORD_TRACK #3" "data 31" "data 32"  "data 3NN")
		    ("XRECORD_TRACK #4" "data 41" "data 42"  "data 4NN")
		    ("XRECORD_TRACK #5" "data 51" "data 52"  "data 5NN")
		    ("XRECORD_TRACK #6" "data 61" "data 62"  "data 6NN")))
(progn
(setq dicts (vla-get-dictionaries adoc))    
(if (vl-catch-all-error-p
(vl-catch-all-apply
(function (lambda ()
(vla-item dicts (car append_data)))))); if dictionary is not exist
(setq first_dict (vla-add dicts (car append_data)))
(setq first_dict (vla-item dicts (car append_data))))
(setq cnt 0)
(setq xrecord_track (cadr append_data))
(setq xrecord_type
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbinteger (cons 1 (length (cddr append_data))))
(reverse (foreach i (cddr append_data)
  (setq type_list (cons (setq cnt (1+ cnt)) type_list))
  ))))
(setq type_list nil); for debug only  
(setq xrecord_data
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbvariant (cons 1 (length (cddr append_data))))
(mapcar 'vl-princ-to-string (cddr append_data))))       
(vla-addxrecord first_dict xrecord_track)
(setq xrecord_obj (vla-getobject first_dict xrecord_track))
(vla-setxrecorddata xrecord_obj xrecord_type xrecord_data)

; Test on creating xrecord :
    
(vla-getxrecorddata (vla-item  first_dict xrecord_track) 'xtp 'xdt)
(setq return_data (mapcar 'vlax-variant-value
			      (vlax-safearray->list  xdt)))
(alert (vl-princ-to-string return_data))
(mapcar (function (lambda (x)
		    (if (not (vlax-object-released-p x))
		      (vlax-release-object x))))
	(list dicts first_dict xrecord_obj))))
(princ)
)

Fatty

~'J'~

Chapay · 19.12.2005, 15:27

Спасибо, Fatty!
Но поставленая мной задача всего лишь маленькая часть курсового проекта, целью котораого является разработка инструмента для работы с пользовательскими словарями и файлами и прочими данными: диалоги создания удаления редактирования файлов словарей и записей и тп....
а вот храницца они должны обязательно как хзапись.
а обьяснять студентам стмысл всего тобой изложеного при отсутсвии у них русской литературы с описанием всех vla-... функций дело не занятное.
надо типа как я писал ранее вот только будет ли оно корректно работать?:
записать
(foreach dict list_dic
(vlax-ldata-put (strcat "$mydic$" (car dict)) "MyKEY" (cdr dict))
)

чуть не написал $mydick$ )))
а забирать: читать все через (entget (namedobjdict)) искать среди них с имнем на "$mydic$"
а потом только через vlax-ldata-get по этим именам забирать свои?
или создавать паралельно свой словарь
со своим уникальным имнем который содержит имена моих словарей или содержит сами эти словари?
и может ли такой словарь занимать более 16 с гаком кб?

VVA · 19.12.2005, 16:06

Можно и через (entget (namedobjdict)), и хранить имена словарей в общем словаре. В общем случае трудно выбрать оптимальное решение.
Просто следует учесть ,что данные [(cdr dict)] -это данное любого типа, используемого в AutoLISP. Это может быть список, как в нашем случае, а может быть список списков. Остановить может только Билл Гейтс, больное воображение или отсутствие оного. По поводу каких-то ограничение ничего в литературе не нашел (в отличие от расширенных данных). Хотя это можно проверить

Код:

[Выделить все]

(setq datalist '(("DICT1" "запись 11" "запись 12" "запись 1N") ("DICT2" "запись 21" "запись 22" "запись 2N") ("DICT3" "запись 31" "запись 32" "запись 3N")))
;;;Заносим данные
(foreach dict datalist
  (if (vlax-ldata-test (cdr dict))  ;_Проверяем, могут ли быть сохранены данные
    (vlax-ldata-put (car dict) "MyKEY" (cdr dict))
    (alert (strcat "Данные словаря " (car dict) "\nневозможно сохранить"))
    )
  )  
;;;Читаем данные
(foreach dict datalist
  (princ (strcat "\nДанные словаря " (car dict) "="))
  (princ (vlax-ldata-get (car dict) "MyKEY"))
)

Frigate · 10.10.2010, 10:46

еще можно искать созданный тобой словарь в семействе Dictionaries по vla-item

gomer · 10.10.2010, 11:31

А в брикскад есть интерфейс для расширенных данных для того чтоб избежать подобного геморроя

Frigate · 10.10.2010, 11:42

а что тут гемморойного-то? Разобрался с основными возможностями словарей за 2 часа. Если нужно упростить работу со словарями - можно написать функции. Да хоть диалоговые окна для рботы со словарями сделать )
Не, меня очень порадовали возможности словарей.

Do$ · 15.12.2010, 11:21

Интересно, кто-нибудь сталкивался с тем, чтобы данные нельзя было сохранить в словаре?
То есть, какой должен быть аргумент функции vlax-ldata-test, чтобы она вернула nil?

19.12.2005, 08:39		#1
Хэ-records Chapay Регистрация: 15.08.2005 Сообщений: 35 Привет всем! Никогда еще не приходилось работать с х-записями Помогите пожалуйста разобраться? Задача такова: Необходимо создать несколько словарей из списка вида (где "записи" - содержание словаря): (setq datalist '(("имя словаря №1" "запись 11" "запись 12" .... "запись 1N") ;- 1и словарь ("имя словаря №2" "запись 21" "запись 22" .... "запись 2N") ;- 2и словарь ("имя словаря №3" "запись 31" "запись 32" .... "запись 3N") ;- 3и словарь ) ) Если в общей базе словарь с таким именем уже есть то его надо полностью заменить словарем из списка datalist. И обратная функция которая из существующих словарей формирует список datalist. Хотя обратную я сам может сделаю.
Просмотров: 7715