; [DCT] ===================================================================================== ;; cd:DCT_AddDict - Dodaje slownik / Adds the dictionary ;; cd:DCT_AddXrecord - Dodaje Xrecord / Adds the Xrecord ;; cd:DCT_GetDict - Pobiera slownik / Gets a dictionary ;; cd:DCT_GetDictList - Pobiera liste slownikow / Gets a list of dictionaries ;; cd:DCT_GetExtDict - Pobiera/Tworzy ExtensionDict. / Gets/Creates an ExtensionDict. ;; cd:DCT_GetExtDictVLA - Pobiera/Tworzy ExtensionDict. / Gets/Creates an ExtensionDict. ;; cd:DCT_GetXrecord - Pobiera Xrecord / Gets Xrecord ;; cd:DCT_RemoveDict - Usuwa slownik / Removes the dictionary ;; cd:DCT_ReplaceXrecord - Podmienia Xrecord / Replace Xrecord ;; cd:DCT_SetXrecordVLA - Zmienia Xrecord / Change Xrecord ; ; =========================================================================================== ;; Dodaje slownik / Adds dictionary ;; Root [ENAME/nil] - ENAME = slownik "rodzic" / "parent" dictionary ;; nil = (namedobjdict) jako "rodzic" / (namedobjdict) as "parent" ;; Name [sTR] - nazwa slownika / name of the dictionary ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_AddDict (namedobjdict) "NAZWA") ;; =========================================================================================== ;(defun cd:DCT_AddDict (Root Name) (dictadd (if (not Root) (namedobjdict) Root) Name (entmakex (append '((0 . "DICTIONARY")(100 . "AcDbDictionary")))) )); =========================================================================================== ;; Dodaje Xrecord / Adds the Xrecord ;; Root [ENAME/nil] - ENAME = slownik "rodzic" / "parent" dictionary ;; nil = (namedobjdict) jako "rodzic" / (namedobjdict) as "parent" ;; XName [sTR] - nazwa xrecord / xrecord name ;; XData [list] - dane xrecord / xrecord data ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_AddXrecord (cd:DCT_GetDict (namedobjdict) "NAZWA") "NAZWA-SUB1" '((1 . "ABC"))) ;; =========================================================================================== ;(defun cd:DCT_AddXrecord (Root XName XData) (dictadd (if (not Root) (namedobjdict) Root) XName (entmakex (append '((0 . "XRECORD")(100 . "AcDbXrecord")) XData)) )); =========================================================================================== ;; Pobiera slownik / Gets a dictionary ;; Root [ENAME/nil] - ENAME = slownik "rodzic" / "parent" dictionary ;; nil = (namedobjdict) jako "rodzic" / (namedobjdict) as "parent" ;; Name [sTR] - nazwa slownika / name of the dictionary ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_GetDict (namedobjdict) "NAZWA") ;; =========================================================================================== ;(defun cd:DCT_GetDict (Root Name) (cdr (assoc -1 (dictsearch (if (not Root) (namedobjdict) Root) Name)))); =========================================================================================== ;; Pobiera liste slownikow "rodzica" / Gets a list of "parent" dictionaries ;; Root [ENAME] - ENAME = slownik "rodzic" / "parent" dictionary ;; Code [T/nil] - T = zwraca / returns -> (( . ) ... ) ;; nil = zwraca / returns -> ( ... ) ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_GetDictList (cd:DCT_GetDict (namedobjdict) "NAZWA") T) ;; =========================================================================================== ;(defun cd:DCT_GetDictList (Root Code / dt tmp res) (if Root (if Code (progn (setq dt (entget Root)) (while (setq dt (member (setq tmp (assoc 3 dt)) dt)) (setq res (cons (cons (cdr tmp) (cdadr dt)) res) dt (cdr dt) ) ) (setq res (reverse res)) ) (setq res (cd:DXF_massoc 3 (entget Root))) ) ) res); =========================================================================================== ;; Pobiera/Tworzy ExtensionDictionary obiektu / Gets/Creates an ExtensionDictionary of object ;; Obj [ENAME/VLA-Object] - obiekt VLA lub entycja / VLA-Object or entity name ;; Flag [T/nil] - T = tworzy / creates ;; nil = pobiera jesli istnieje / gets if exist ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_GetExtDictVLA (car (entsel)) T) ;; =========================================================================================== ;(defun cd:DCT_GetExtDictVLA (Obj Flag / res) (if (= (type Obj) (quote ENAME)) (setq Obj (vlax-ename->vla-object Obj)) ) (if (setq res (if (= :vlax-true (vla-get-HasExtensionDictionary Obj)) (vla-GetExtensionDictionary Obj) (if Flag (vla-GetExtensionDictionary Obj)) ) ) (vlax-vla-object->ename res) )); =========================================================================================== ;; Pobiera/Tworzy ExtensionDictionary obiektu / Gets/Creates an ExtensionDictionary of object ;; Ename [ENAME] - nazwa entycji / entity name ;; Flag [T/nil] - T = tworzy / creates ;; nil = pobiera jesli istnieje / gets if exist ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_GetExtDict (car (entsel)) T) ;; =========================================================================================== ;(defun cd:DCT_GetExtDict (Ename Flag / res he ta) (if (and (= (type Ename) (quote ENAME)) (setq dt (entget Ename)) ) (if (not (setq res (cdr (assoc 360 (member '(102 . "{ACAD_XDICTIONARY") dt))))) (if Flag (progn (setq res (entmakex (append '((0 . "DICTIONARY") (100 . "AcDbDictionary")))) he (reverse (member (assoc 5 dt) (reverse dt))) ta (cdr (member (assoc 5 dt) dt)) ) (entmod (append he (list '(102 . "{ACAD_XDICTIONARY") (cons 360 res) '(102 . "}") ) ta ) ) ) ) ) ) res); =========================================================================================== ;; Pobiera Xrecord / Gets Xrecord ;; Ename [ENAME] - nazwa entycji / entity name ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_GetXrecord (cdar (cd:DCT_GetDictList (cd:DCT_GetDict (namedobjdict) "NAZWA") T))) ;; =========================================================================================== ;(defun cd:DCT_GetXRecord (Ename / dt) (cdr (member (assoc 280 (setq dt (entget Ename))) dt))); =========================================================================================== ;; Usuwa slownik / Removes the dictionary ;; Root [ENAME/nil] - ENAME = slownik "rodzic" / "parent" dictionary ;; nil = (namedobjdict) jako "rodzic" / (namedobjdict) as "parent" ;; Name [sTR] - nazwa slownika / name of the dictionary ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_RemoveDict (namedobjdict) "NAZWA") ;; =========================================================================================== ;(defun cd:DCT_RemoveDict (Root Name) (dictremove (if (not Root) (namedobjdict) Root) Name)); =========================================================================================== ;; Podmienia Xrecord / Replace Xrecord ;; Ename [ENAME] - nazwa entycji xrecord / entity name xrecord ;; Data [list] - lista par kropkowych / list of dotted pairs ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_ReplaceXrecord ;; (cdar (cd:DCT_GetDictList (cd:DCT_GetDict (namedobjdict) "NAZWA") T)) ;; (list (cons 1 "NEW") (cons 341 (car (entsel))))) ;; =========================================================================================== ;(defun cd:DCT_ReplaceXrecord (Ename Data / en root name) (setq root (cdr (assoc 330 (entget Ename))) name (cdr (assoc Ename (mapcar (function (lambda (%) (cons (cdr %) (car %)) ) ) (cd:DCT_GetDictList root T) ) ) ) ) (if (cd:DCT_RemoveDict root name) (progn (setq en (cd:DCT_AddXrecord root name Data)) (cd:DCT_GetXRecord en) ) )); =========================================================================================== ;; Zmienia Xrecord / Change Xrecord ;; Ename [ENAME] - nazwa entycji / entity name ;; Data [list] - lista par kropkowych / list of dotted pairs ;; ------------------------------------------------------------------------------------------- ;; (cd:DCT_SetXrecordVLA ;; (cdar (cd:DCT_GetDictList (cd:DCT_GetDict (namedobjdict) "NAZWA") T)) ;; (list (cons 1 "NEW123") (cons 341 (car (entsel))))) ;; =========================================================================================== ;(defun cd:DCT_SetXrecordVLA (Ename Data / n) (setq n (1- (length Data))) (vla-SetXRecordData (vlax-ename->vla-object Ename) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbInteger (cons 0 n) ) (mapcar (quote car) Data) ) ) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbVariant (cons 0 n) ) (mapcar (function (lambda (% / %1) (setq %1 (type %)) (cond ( (= %1 (quote ENAME)) (vlax-ename->vla-object %)) ( (= %1 (quote LIST)) (vlax-3d-point %)) (T %) ) ) ) (mapcar (quote cdr) Data) ) ) ) ) (cd:DCT_GetXRecord Ename)); =========================================================================================== ;; Zwraca wartosc danego klucza z listy asocjacyjnej / ;; Returns the value of a key from assoc list ;; Key [iNT] - klucz / key ;; Data [list] - lista par kropkowych / list of dotted pairs ;; ------------------------------------------------------------------------------------------- ;; (cd:DXF_Massoc 10 (entget (car (entsel)))) ;; =========================================================================================== ;(defun cd:DXF_Massoc (Key Data / res tmp) (while (setq Data (member (setq tmp (assoc Key Data)) Data)) (setq res (cons (cdr tmp) res) Data (cdr Data) ) ) (reverse res)) 
置顶卡
