[LISP程序]：请高手帮帮我，关于XRecord的

小狼 · 发表于 2004-11-19 22:29:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

“JPG”文件显示上面有一个快是“地藉基本属性”下面的是“地藉扩展属性”

“地藉基本属性”是在实体的扩展数据里面没错，可是“地藉扩展属性”像“区号”等都是在扩展记录里面，而且是以“southdiji”命名的字典，我用上面的方法试了，查不出来，用ENTGET直接去360组得到的，麻烦在帮我看看咯，我不知道怎么修改，直接这样更新"XRECORD")实体没用。
真的急用。谢谢

这是实体的360组
((-1 . <Entity name: 4008d2b8>) (0 . "DICTIONARY") (330 .
<Entity name: 4008cd88>) (5 . "8D7") (100 . "AcDbDictionary") (280 . 1) (281 .
1) (3 . "SOUTHDIJI") (360 . <Entity name: 4008d2c0>))

这就是属性
((-1 . <Entity name: 4008d2c0>) (0 . "XRECORD") (5 . "8D8") (102
. "{ACAD_REACTORS") (330 . <Entity name: 4008d2b8>) (102 . "}") (330 . <Entity
name: 4008d2b8>) (100 . "AcDbXrecord") (280 . 1) (1 . "01") (1 . "") (1 . "")
(1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 .
"") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1 . "") (1
. "") (1 . "") (1 . "") (40 . 144.169) (40 . 0.0) (40 . 0.0) (70 . 1) (70 . 1)
(70 . 1) (70 . 1))

(1 . "01")就是区号

eachy · 发表于 2004-11-20 00:08:11

http://www.xdcad.net/forum/showt ... ostid=8773#post8773

自由的鱼 · 发表于 2004-11-20 00:43:16

太穷了，得想办法赚钱了，呵呵~~

小狼 · 发表于 2004-11-21 09:54:49

别这样啊,我问了很久了，怎么没人能真正看下我的数据吗?
扩展记录是在实体上的，字典里面根本没有
你们写的方法根本就查不到,也修改不了
麻烦你们试一下

eachy · 发表于 2004-11-21 23:31:47

最初由小狼发布
[B]别这样啊,我问了很久了，怎么没人能真正看下我的数据吗?
扩展记录是在实体上的，字典里面根本没有
你们写的方法根本就查不到,也修改不了
麻烦你们试一下 [/B]

[iframe h=600]http://www.cadian.com/board_qna/content.asp?idx=6376&page=3&mcate=B[/iframe]

[iframe h=600]http://www.xoutside.com/CAD/chair/lisp/num65/011129--65.htm[/iframe]

(vl-load-com)
(if (not *acadx*)
(setq *acadx*
(vla-getInterfaceObject
(vlax-get-acad-object)
"AcadX.Application"
)
)
)
(defun GetDataTip (vArgs / args Entity SubEntity ex)
(setq args (vlax-safeArray->list (vlax-variant-value vArgs))
Entity (car args)
SubEntity (cadr args)
)
(if (vl-catch-all-error-p
(setq ex (vl-catch-all-apply
'dict-obj-get
(list SubEntity "kht1")
)
)
)
(strcat "? ?????? ?? ??? ????.\n")
(strcat
"???"
(vlax-invoke-method
*acadx*
'GetDXFName
SubEntity
)
"???!!"
"\n????1 : "
(car ex)
"\n"
"\n????2 : "
(cadr ex)
"\n"
"\n??? ***? ??? ???."
)
)
)
(defun dict-obj-get (obj RecordName / acadObject
acadDocument obj dicts dict
xrec typ dat
)
(vl-load-com)
(setq dict (vla-getextensionDictionary obj))
(setq xrec (VLA-AddXRecord DICT RecordName))
(vla-getxrecorddata xrec 'typ 'dat)
(setq typ (vlax-safearray->list typ))
(setq dat (vlax-safearray->list dat))
(mapcar 'vlax-variant-value dat)
)
(defun TipActive (UseChk /)
(command "vbastmt"
(strcat "thisdrawing.datatip.active = "
(if UseChk
"True"
"False"
)
)
)
)
(defun vlax-TipActive (UseChk / datatip)
(setq datatip (vlax-get-property *acadx* 'datatip))
(vlax-put-property
datatip
'active
(if UseChk
:vlax-true
:vlax-false
)
)
)
(defun TipDelay (Time /)
(if (< time 10)
(setq time "10")
(setq time (itoa (fix time)))
)
(command "vbastmt"
(strcat "thisdrawing.datatip.ShowDelay = " time)
)
)
(defun vlax-TipDelay (Time / datatip)
(if (< time 10)
(setq time 10)
(setq time (fix time))
)
(setq datatip (vlax-get-property *acadx* 'datatip))
(vlax-put-property datatip 'ShowDelay time)
)
(defun kht:list->variantArray (ptsList datatype / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
(eval datatype)
(cons 0
(- (length ptsList) 1)
)
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
(defun kht:list->intlist (lis / n)
(setq n 0)
(mapcar '(lambda (x) (setq n (1+ n))) lis)
)
(defun dict-set-get
(lis / acadObject acadDocument dicts dict xrec typ dat)
(vl-load-com)
(setq acadObject (vlax-get-acad-object))
(setq acadDocument (vla-get-ActiveDocument acadObject))
(setq dicts (vla-get-Dictionaries acadDocument))
(setq dict (vlax-invoke dicts "ADD" "mydict"))
(setq xrec (VLA-AddXRecord DICT "kht1"))
(vla-SetXRecordData
xrec
(kht:list->variantArray
(kht:list->intlist lis)
'vlax-vbinteger
)
(kht:list->variantArray lis 'vlax-vbvariant)
)
(vla-getxrecorddata xrec 'typ 'dat)
(setq typ (vlax-safearray->list typ))
(setq dat (vlax-safearray->list dat))
(mapcar 'vlax-variant-value dat)
)
(defun kht:list->variantArray (ptsList datatype / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
(eval datatype)
(cons 0
(- (length ptsList) 1)
)
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
;; ? (kht:list->intlist '("as" "sfds" "fdsf")) => (1 2 3)
(defun kht:list->intlist (lis / n)
(setq n 0)
(mapcar '(lambda (x) (setq n (1+ n))) lis)
)
(defun dict-set-get
(lis / acadObject acadDocument dicts dict xrec typ dat)
(vl-load-com)
(setq acadObject (vlax-get-acad-object))
(setq acadDocument (vla-get-ActiveDocument acadObject))
(setq dicts (vla-get-Dictionaries acadDocument))
(setq dict (vlax-invoke dicts "ADD" "mydict"))
(setq xrec (VLA-AddXRecord DICT "kht1"))
(vla-SetXRecordData
xrec
;; SetXRecordData ? type ?? integer variant ???
;; ?(list)? variant ??? ?????.
;; kht:list->variantArray ??? ???? ???? ??? ???? ?????.
(kht:list->variantArray
(kht:list->intlist lis)
'vlax-vbinteger
)
(kht:list->variantArray lis 'vlax-vbvariant)
)
(vla-getxrecorddata xrec 'typ 'dat)
(setq typ (vlax-safearray->list typ))
(setq dat (vlax-safearray->list dat))
(mapcar 'vlax-variant-value dat)
)

(vl-load-com) 
(if (not *acadx*) 
  (setq        *acadx* 
         (vla-getInterfaceObject 
           (vlax-get-acad-object) 
           "AcadX.Application" 
         ) 
  ) 
) 
(defun GetDataTip (vArgs / args Entity SubEntity ex) 
  (setq        args          (vlax-safeArray->list (vlax-variant-value vArgs)) 
        Entity          (car args) 
        SubEntity (cadr args) 
  ) 
  (if (vl-catch-all-error-p 
        (setq ex (vl-catch-all-apply 
                   'dict-obj-get 
                   (list SubEntity "kht1") 
                 ) 
        ) 
      ) 
    (strcat "? ?????? ?? ??? ????.\n") 
    (strcat 
      "???" 
      (vlax-invoke-method 
        *acadx* 
        'GetDXFName 
        SubEntity 
      ) 
      "???!!" 
      "\n????1 : " 
      (car ex) 
      "\n" 
      "\n????2 : " 
      (cadr ex) 
      "\n" 
      "\n??? ***? ??? ???." 
    ) 
  ) 
) 
(defun dict-obj-get (obj       RecordName           /             acadObject 
                     acadDocument         obj           dicts     dict 
                     xrec      typ         dat 
                    ) 
  (vl-load-com) 
  (setq dict (vla-getextensionDictionary obj)) 
  (setq xrec (VLA-AddXRecord DICT RecordName)) 
  (vla-getxrecorddata xrec 'typ 'dat) 
  (setq typ (vlax-safearray->list typ)) 
  (setq dat (vlax-safearray->list dat)) 
  (mapcar 'vlax-variant-value dat) 
) 
(defun TipActive (UseChk /) 
  (command "vbastmt" 
           (strcat "thisdrawing.datatip.active = " 
                   (if UseChk 
                     "True" 
                     "False" 
                   ) 
           ) 
  ) 
) 
(defun vlax-TipActive (UseChk / datatip) 
  (setq datatip (vlax-get-property *acadx* 'datatip)) 
  (vlax-put-property 
    datatip 
    'active 
    (if        UseChk 
      :vlax-true 
      :vlax-false 
    ) 
  ) 
) 
(defun TipDelay        (Time /) 
  (if (< time 10) 
    (setq time "10") 
    (setq time (itoa (fix time))) 
  ) 
  (command "vbastmt" 
           (strcat "thisdrawing.datatip.ShowDelay = " time) 
  ) 
) 
(defun vlax-TipDelay (Time / datatip) 
  (if (< time 10) 
    (setq time 10) 
    (setq time (fix time)) 
  ) 
  (setq datatip (vlax-get-property *acadx* 'datatip)) 
  (vlax-put-property datatip 'ShowDelay time) 
) 
(defun kht:list->variantArray (ptsList datatype / arraySpace sArray) 
  (setq        arraySpace 
         (vlax-make-safearray 
           (eval datatype) 
           (cons 0 
                 (- (length ptsList) 1) 
           ) 
         ) 
  ) 
  (setq sArray (vlax-safearray-fill arraySpace ptsList)) 
  (vlax-make-variant sArray) 
) 
 
(defun kht:list->intlist (lis / n) 
  (setq n 0) 
  (mapcar '(lambda (x) (setq n (1+ n))) lis) 
) 
 
(defun dict-set-get 
       (lis / acadObject acadDocument dicts dict xrec typ dat) 
  (vl-load-com) 
 
  (setq acadObject (vlax-get-acad-object)) 
  (setq acadDocument (vla-get-ActiveDocument acadObject)) 
  (setq dicts (vla-get-Dictionaries acadDocument)) 
  (setq dict (vlax-invoke dicts "ADD" "mydict")) 
  (setq xrec (VLA-AddXRecord DICT "kht1")) 
 
  (vla-SetXRecordData 
    xrec 
    (kht:list->variantArray 
      (kht:list->intlist lis) 
      'vlax-vbinteger 
    ) 
    (kht:list->variantArray lis 'vlax-vbvariant) 
  ) 
 
  (vla-getxrecorddata xrec 'typ 'dat) 
  (setq typ (vlax-safearray->list typ)) 
  (setq dat (vlax-safearray->list dat)) 
  (mapcar 'vlax-variant-value dat) 
) 
(defun kht:list->variantArray (ptsList datatype / arraySpace sArray) 
  (setq        arraySpace 
         (vlax-make-safearray 
           (eval datatype) 
           (cons 0 
                 (- (length ptsList) 1) 
           ) 
         ) 
  ) 
  (setq sArray (vlax-safearray-fill arraySpace ptsList)) 
  (vlax-make-variant sArray) 
) 
;; ? (kht:list->intlist '("as" "sfds" "fdsf")) => (1 2 3) 
(defun kht:list->intlist (lis / n) 
  (setq n 0) 
  (mapcar '(lambda (x) (setq n (1+ n))) lis) 
) 
 
(defun dict-set-get 
       (lis / acadObject acadDocument dicts dict xrec typ dat) 
  (vl-load-com) 
 
  (setq acadObject (vlax-get-acad-object)) 
  (setq acadDocument (vla-get-ActiveDocument acadObject)) 
  (setq dicts (vla-get-Dictionaries acadDocument)) 
  (setq dict (vlax-invoke dicts "ADD" "mydict")) 
  (setq xrec (VLA-AddXRecord DICT "kht1")) 
  (vla-SetXRecordData 
    xrec 
    ;; SetXRecordData ? type ?? integer variant ??? 
    ;; ?(list)? variant ??? ?????. 
    ;; kht:list->variantArray ??? ???? ???? ??? ???? ?????. 
    (kht:list->variantArray 
      (kht:list->intlist lis) 
      'vlax-vbinteger 
    ) 
    (kht:list->variantArray lis 'vlax-vbvariant) 
  ) 
  (vla-getxrecorddata xrec 'typ 'dat) 
  (setq typ (vlax-safearray->list typ)) 
  (setq dat (vlax-safearray->list dat)) 
  (mapcar 'vlax-variant-value dat) 
)

小狼 · 发表于 2004-11-22 21:01:41

(if (not *acadx*)
  (setq *acadx*
   (vla-getInterfaceObject
   (vlax-get-acad-object)
   "AcadX.Application"
   )
  )
)
; error: Automation Error. Problem in loading application
是为什么啊？

LUCAS · 发表于 2004-11-23 07:54:31

AcadX.Application是外掛程序,現在要收錢了!
Tony Tanzillo作者
http://www.caddzone.com
AcadXTabs: MDI Document Tabs for AutoCAD 2004/2005
http://www.acadxtabs.com

Free-Lancer · 发表于 2004-11-24 23:57:49

(defun c:test (/ e el dict dename)
(if
(and (setq el (entget (car (entsel))))
(setq dict (cdr (assoc 360 el)))
(= (cdr (assoc 0 (setq dename (entget dict)))) "DICTIONARY")
(= (cdr
(assoc 0
(setq xrec (dictsearch dict (cdr (assoc 3 dename))))
)
)
"XRECORD"
)
)
(cddr
(member '(100 . "AcDbXrecord") xrec)
)
)
)
(defun c:test0 (/ e subst-n el dict xrec)
(defun subst-n (lst nlst n / i)
(setq i -1)
(if (= (type n) 'LIST)
(mapcar '(lambda (x)
(setq i (1+ i))
(if (vl-position i n)
(nth (vl-position i n)
nlst
)
x
)
)
lst
)
(mapcar '(lambda (x)
(setq i (1+ i))
(if (= i n)
nlst
x
)
)
lst
)
)
)
(if
(and (setq el (entget (car (entsel))))
(setq dict (cdr (assoc 360 el)))
(= (cdr (assoc 0 (setq dename (entget dict)))) "DICTIONARY")
(= (cdr
(assoc 0
(setq xrec
(dictsearch dict (setq dname(cdr (assoc 3 dename))))
)
)
)
"XRECORD"
)
)
(progn
(dictremove dict dname)
(dictadd
dict
dname
(entmakex (cons '(0 . "xrecord")
(member '(100 . "AcDbXrecord") (subst-n xrec '(1 . "02") 9))
)
)
)
)
)
(princ)
)

(defun c:test (/ e el dict dename) 
  (if 
    (and (setq el (entget (car (entsel)))) 
         (setq dict (cdr (assoc 360 el))) 
         (= (cdr (assoc 0 (setq dename (entget dict)))) "DICTIONARY") 
         (= (cdr 
              (assoc 0 
                     (setq xrec (dictsearch dict (cdr (assoc 3 dename)))) 
              ) 
            ) 
            "XRECORD" 
         ) 
    ) 
     (cddr 
       (member '(100 . "AcDbXrecord") xrec) 
     ) 
  ) 
) 
(defun c:test0 (/ e subst-n el dict xrec) 
  (defun subst-n (lst nlst n / i) 
    (setq i -1) 
    (if        (= (type n) 'LIST) 
      (mapcar '(lambda (x) 
                 (setq i (1+ i)) 
                 (if (vl-position i n) 
                   (nth        (vl-position i n) 
                        nlst 
                   ) 
                   x 
                 ) 
                  
               ) 
              lst 
      ) 
      (mapcar '(lambda (x) 
                 (setq i (1+ i)) 
                 (if (= i n) 
                   nlst 
                   x 
                 )                  
               ) 
              lst 
      ) 
    ) 
  )    
  (if 
    (and (setq el (entget (car (entsel)))) 
         (setq dict (cdr (assoc 360 el))) 
         (= (cdr (assoc 0 (setq dename (entget dict)))) "DICTIONARY") 
         (= (cdr 
              (assoc 0 
                     (setq xrec 
                            (dictsearch dict (setq dname(cdr  (assoc 3 dename)))) 
                     ) 
              ) 
            ) 
            "XRECORD" 
         ) 
    ) 
    (progn 
      (dictremove dict dname) 
      (dictadd 
        dict 
        dname 
        (entmakex (cons        '(0 . "xrecord") 
                        (member '(100 . "AcDbXrecord") (subst-n xrec '(1 . "02") 9)) 
                  ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

小狼 · 发表于 2004-11-28 10:24:22

如果实体本省没有记录，要添加字典怎么做啊？

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：请高手帮帮我，关于XRecord的

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块