使用Vlisp获取和设置扩展数据

Free-Lancer

Question
I have to access XDatas inside a Visual LISP reactor, but I cannot use (entget)
or (entmod). Is it possible to use the (vla-getxxx) and (vla-setxxx) functions
to do this?
Answer
You can use the (vla-GetXData) and (vla-SetXData) functions. These functions are
not documented (as are most the Visual LISP online help).

To get more information about these functions, look at the function description
of GetXData and SetXData in the ACADAUTO.HLP help file (the AutoCAD ActiveX and
VBA Reference).

Here is a short description of the functions:

(vla-GetXData entity appName 'codes 'datas)

entity:
This is the entity name of an AutoCAD entity.

appName:
This is a string with the application name. The functions returns all XDatas
belonging to the specified application. If appName is "", the functions returns
all XDatas attached to 'entity'.

codes:
This list receives the XData group codes.

datas:
This list receives the datas of the group codes specified in 'codes'

(vla-SetXData entity codes datas)

entity:
This is the entity name of an AutoCAD entity.

codes:
This list defines the XData group codes.

datas:
This list contains the datas for the specified group codes

The following is a sample code which attaches some XData to every entity in
model space.After this, it extracts the XData of every entity from every
application:

2. 
   
3. (defun c:setandgetxdatas ()
   
4.   (vl-load-com)
   
5. 
   
6.   ;; Get objects
   
7.   (setq acadApp (vlax-get-acad-object)
   
8. acadDoc (vla-get-ActiveDocument acadApp)
   
9. mspace (vla-get-ModelSpace acadDoc)
   
10.   )  ;; Register an application name
    
11.   (regapp "MYAPP")  ;; Attach some xdatas:
    
12.   ;; 1001: application name  ;; 1000: string ;; 1010: 3D point ;; 1040: real ;; 1070: 16bit integer
    
13.   (setq codes  '(1001 1000 1010 1040 1070)
    
14. values '("MYAPP" "XDATA String" (1.0 1.0 0.0) 5.0 4)
    
15.   )
    
16.   ;; Create the Safe and Variant Arrays needed for vla-SetXData
    
17.   (setq ListLength (1- (length codes)))
    
18.   (setq ArrayTypes
    
19.   (vlax-make-safearray
    
20.     vlax-vbInteger
    
21.     (cons 0 ListLength)
    
22.   )
    
23.   )
    
24.   (setq ArrayValues
    
25.   (vlax-make-safearray
    
26.     vlax-vbVariant
    
27.     (cons 0 ListLength)
    
28.   )
    
29.   )
    
30.   (vlax-safearray-fill ArrayTypes codes)
    
31. ; simple list works
    
32. ; A more complex list needs to be constructed one element at a time:
    
33.   (setq i 0)
    
34.   (while (< i ListLength)
    
35.     (if (equal (type (setq lstElem (nth i values))) 'LIST)
    
36.       (vlax-safearray-put-element
    
37. ArrayValues
    
38. i
    
39. (vlax-3d-point lstElem)
    
40.       )
    
41.       (vlax-safearray-put-element ArrayValues i (nth i values))
    
42.     )
    
43.     (setq i (1+ i))
    
44.   )
    
45.   
    
46.   (setq VarTypes (vlax-make-variant ArrayTypes))
    
47.   (setq VarValues (vlax-make-variant ArrayValues))
    
48.   (vlax-for ent mspace (vla-SetXData ent VarTypes VarValues))
    
49.   (princ "\nFinished storing XData on All Drawing entities.\n"
    
50.   )
    
51.   (setq EntIndx 0)
    
52.   ;; Get all xdatas from entities
    
53.   (princ "\nReading XData from drawing entities.\n")
    
54.   (vlax-for ent mspace
    
55.     (princ (strcat "\n\nEntity(" (itoa EntIndx) "): "))
    
56.     (princ (vla-get-ObjectName ent))
    
57.     (princ "\nXData: ");;; Deconstruct the Variant Array return of vla-GetXData to SafeArrays, and thento a list
    
58.     (setq VarDataTypes nil
    
59.    VarDataValues nil
    
60.     )
    
61.     (vla-GetXData ent "" 'VarDataTypes 'VarDataValues)
    
62.     (if (/= VarDataTypes nil)
    
63.       (progn
    
64. (setq LispList nil)
    
65. ;; Get the dimension of the safearray
    
66. (setq lBound (vlax-safearray-get-l-bound VarDataTypes 1))
    
67. (setq uBound (vlax-safearray-get-u-bound VarDataTypes 1))
    
68. (setq aCounter lBound)
    
69. (while (<= aCounter uBound)
    
70.    (setq dataCode (vlax-safearray-get-element
    
71.       VarDataTypes
    
72.       aCounter
    
73.     )
    
74.    )
    
75.    (setq VarValue (vlax-safearray-get-element
    
76.       VarDataValues
    
77.       aCounter
    
78.     )
    
79.    )
    
80.    ;; VarValue contains the variant, but we need the Lisp value of it
    
81.    (if (and (> dataCode 1009) (< dataCode 1040))
    
82.      ;; Test to see if it's a point Variant
    
83.      (progn (setq saValue (vlax-variant-value VarValue))
    
84.      (setq Value (vlax-safearray->list saValue))
    
85.      )
    
86.      (setq Value (vlax-variant-value VarValue))
    
87.    )
    
88.    ;; Create the list
    
89.    (setq
    
90.      LispList (append LispList (list (cons dataCode Value)))
    
91.    )
    
92.    (setq aCounter (1+ aCounter))
    
93. ) ;_ end of while
    
94.       ) ;_ end of progn
    
95.       (setq LispList nil)
    
96.     ) ;_ end of if
    
97.     (if LispList
    
98.       (progn (princ "\n\tCodes: ")
    
99.       (foreach LstItem LispList
    
100.         (princ (car LstItem))
     
101.         (princ "  ")
     
102.       )
     
103.       (princ "\n\tData: ")
     
104.       (foreach LstItem LispList
     
105.         (princ (cdr LstItem))
     
106.         (princ "  ")
     
107.       )
     
108.       )
     
109.     )
     
110.     (setq EntIndx (1+ EntIndx))
     
111.   )
     
112.   (princ)
     
113. )(princ
     
114.   "\nc:setandgetxdatas2 loaded, type setandgetxdatas2 to run."
     
115. )
     
116. (princ)

<br /> (defun c:setandgetxdatas ()<br />   (vl-load-com)<br /> <br />   ;; Get objects<br />   (setq acadApp (vlax-get-acad-object)<br /> acadDoc (vla-get-ActiveDocument acadApp)<br /> mspace (vla-get-ModelSpace acadDoc)<br />   )  ;; Register an application name<br />   (regapp "MYAPP")  ;; Attach some xdatas:<br />   ;; 1001: application name  ;; 1000: string ;; 1010: 3D point ;; 1040: real ;; 1070: 16bit integer<br />   (setq codes  '(1001 1000 1010 1040 1070)<br /> values '("MYAPP" "XDATA String" (1.0 1.0 0.0) 5.0 4)<br />   )<br />   ;; Create the Safe and Variant Arrays needed for vla-SetXData<br />   (setq ListLength (1- (length codes)))<br />   (setq ArrayTypes<br />   (vlax-make-safearray<br />     vlax-vbInteger<br />     (cons 0 ListLength)<br />   )<br />   )<br />   (setq ArrayValues<br />   (vlax-make-safearray<br />     vlax-vbVariant<br />     (cons 0 ListLength)<br />   )<br />   )<br />   (vlax-safearray-fill ArrayTypes codes)<br /> ; simple list works<br /> ; A more complex list needs to be constructed one element at a time:<br />   (setq i 0)<br />   (while (< i ListLength)<br />     (if (equal (type (setq lstElem (nth i values))) 'LIST)<br />       (vlax-safearray-put-element<br /> ArrayValues<br /> i<br /> (vlax-3d-point lstElem)<br />       )<br />       (vlax-safearray-put-element ArrayValues i (nth i values))<br />     )<br />     (setq i (1+ i))<br />   )<br />   <br />   (setq VarTypes (vlax-make-variant ArrayTypes))<br />   (setq VarValues (vlax-make-variant ArrayValues))<br />   (vlax-for ent mspace (vla-SetXData ent VarTypes VarValues))<br />   (princ "\nFinished storing XData on All Drawing entities.\n"<br />   )<br />   (setq EntIndx 0)<br />   ;; Get all xdatas from entities<br />   (princ "\nReading XData from drawing entities.\n")<br />   (vlax-for ent mspace<br />     (princ (strcat "\n\nEntity(" (itoa EntIndx) "): "))<br />     (princ (vla-get-ObjectName ent))<br />     (princ "\nXData: ");;; Deconstruct the Variant Array return of vla-GetXData to SafeArrays, and thento a list<br />     (setq VarDataTypes nil<br />    VarDataValues nil<br />     )<br />     (vla-GetXData ent "" 'VarDataTypes 'VarDataValues)<br />     (if (/= VarDataTypes nil)<br />       (progn<br /> (setq LispList nil)<br /> ;; Get the dimension of the safearray<br /> (setq lBound (vlax-safearray-get-l-bound VarDataTypes 1))<br /> (setq uBound (vlax-safearray-get-u-bound VarDataTypes 1))<br /> (setq aCounter lBound)<br /> (while (<= aCounter uBound)<br />    (setq dataCode (vlax-safearray-get-element<br />       VarDataTypes<br />       aCounter<br />     )<br />    )<br />    (setq VarValue (vlax-safearray-get-element<br />       VarDataValues<br />       aCounter<br />     )<br />    )<br />    ;; VarValue contains the variant, but we need the Lisp value of it<br />    (if (and (> dataCode 1009) (< dataCode 1040))<br />      ;; Test to see if it's a point Variant<br />      (progn (setq saValue (vlax-variant-value VarValue))<br />      (setq Value (vlax-safearray->list saValue))<br />      )<br />      (setq Value (vlax-variant-value VarValue))<br />    )<br />    ;; Create the list<br />    (setq<br />      LispList (append LispList (list (cons dataCode Value)))<br />    )<br />    (setq aCounter (1+ aCounter))<br /> ) ;_ end of while<br />       ) ;_ end of progn<br />       (setq LispList nil)<br />     ) ;_ end of if<br />     (if LispList<br />       (progn (princ "\n\tCodes: ")<br />       (foreach LstItem LispList<br />         (princ (car LstItem))<br />         (princ "  ")<br />       )<br />       (princ "\n\tData: ")<br />       (foreach LstItem LispList<br />         (princ (cdr LstItem))<br />         (princ "  ")<br />       )<br />       )<br />     )<br />     (setq EntIndx (1+ EntIndx))<br />   )<br />   (princ)<br /> )(princ<br />   "\nc:setandgetxdatas2 loaded, type setandgetxdatas2 to run."<br /> )<br /> (princ)

For additional AutoLISP code that creates and reads Xdata using ActiveX, see
the Xdata_Variants.Lsp sample in the
\Acad2000\Sample\VisualLisp directory..

hyx_lyn

楼上的会中文吗？

很多人都看不懂英文，对你所表达的就不懂了

其实我也不懂英文

aidraft

这是AutoLisp方法的版本
[php];----------------------------------------------------------
;  Extended data Utilities and Example of use
;  From 1999 Autodesk University course PR31
;  taught by Bill Kramer
;
; Utilities:
;  X_DATA_GET - get extended data list from entity
;  X_DATA_ADD - add extended data to entity
;  X_DATA_DEL - remove extended data from entity
;  X_DATA_APPIDS - build list of registered applications
;  NTH_SUBST - substitute nth member in list
;
;  C:EST - estimation example application shows use of
;          extended data to house bill of material info
;          about objects.
;----------------------------------------------------------;;
;; X_DATA_GET: Utility to get the extended data
;; list for an entity (EN) for a given application name (APID).
;;
(defun X_DATA_GET (EN APID / EL)
  (setq EL (entget EN (list APID)))
  (cdadr (assoc -3 EL)) ;;return only data items
)
;;---------------------------------------------------------
;; X_DATA_ADD  add extended data list DLST with
;;             application name APID to the entity list
;;             of entity name EN.
;;             Overwrites existing.
;;
(defun X_DATA_ADD (EN APID DLST / EL TMP1)
   (if (null (tblsearch "APPID" APID)) ;;registered?
      (regapp APID)) ;;register it
   (setq EL (entget EN) ;;get Entity list
         TMP1 (list -3 (cons APID DLST))
   )
   (if (< (xdsize TMP1) (xdroom EN)) ;;got enough room?
      (entmod (append EL (list TMP1)))) ;;modify database
)
;;---------------------------------------------------------
;; X_DATA_DEL - Utlity to remove the extended data for
;; an application (APID) from an entity object (EN).
;;
(defun X_DATA_DEL (EN APID / EL TMP1 TMP2)
   (if (setq TMP2 (X_DATA_APPIDS)) ;;find X data?
     (progn
       (setq EL (entget EN TMP2)  ;;get ALL data
             TMP1 (assoc -3 EL)   ;;get X data
       )
       ;;is APID in X data info for object?
       (if (assoc APID (cdr TMP1))
         (progn
          (setq TMP1 (cdr TMP1) ;;take off -3
                TMP1 ;;remove existing X data
                  (append ;;rebuild X data list
                    (list -3)
                    (reverse ;;X data before APID
                      (cdr
                        (member
                          (assoc APID TMP1)
                          (reverse TMP1))))
                    (cdr     ;;X data after APID
                      (member
                        (assoc APID TMP1)
                        TMP1)))
                EL (subst TMP1 (assoc -3 EL) EL)
          )
          (entdel EN) ;;remove previous member
          (entmake EL))))));;add with modified X data
;;---------------------------------------------------------
;; X_DATA_APPIDS - Creates a list of all application
;; names in the current drawing by stepping through
;; the APPID table.
;;
(defun X_DATA_APPIDS ( / TMP1 TMP2)   
   ;;Build list of X data ID's
   (setq TMP1 (tblnext "APPID" 'T)) ;;get 1st APPID
   (while TMP1 ;;loop until no more APPID's in table
     (setq TMP2 (cons ;;add APPID to list
                  (cdr (assoc 2 TMP1))
                  TMP2)
           TMP1 (tblnext "APPID") ;;get next APPID
     )
   )
   TMP2 ;;return TMP2 list
)
;;---------------------------------------------------------
;
; Utility routine for substitution
; in a list at the Nth specified position.
;
(defun NTH_SUBST (NN New Dlist)
  (cond
    ((null Dlist) nil)
    ((= NN 0) (cons New (cdr Dlist)))
    (t (cons
         (car Dlist)
         (NTH_SUBST (1- NN) New (cdr Dlist))))))
;
;;---------------------------------------------------------
;;
;; C:EST - Estimator application example
;;
(defun C:EST ( / TMP DONE)
   (setq APID "ESTIMATOR")
   (prompt "\nESTimator tool for AutoCAD.")
   (while (null DONE)
     (initget 0 "Sum Edit Look Add Del Xit")
     (setq TMP
       (getkword
          "\nEST: Sum/Edit/Look/Add/Del/<Xit>: "))
     (cond
       ((or (null TMP) (= TMP "Xit"))
          (setq DONE 'T))
       ((= TMP "Sum") (EST_SUM APID)) ;;see listing 18
       ((= TMP "Edit") (EST_EDIT APID)) ;;see listing 15
       ((= TMP "Look") (EST_LOOK APID)) ;;see listing 17
       ((= TMP "Add") (EST_ADD APID)) ;;see listing 14
       ((= TMP "Del") (EST_DEL APID)) ;;see listing 16
     )
   )
   (princ)
)
;---------------------------------------------------------
;
; Add new Xdata for the estimator.
;
(defun EST_ADD (APID / EN T1 T2)
  (setq EN (car (entsel "\nSelect object: ")))
  (if EN
    (progn
       (setq T1 (getstring 1 "\nDescription: "))
       (if (/= T1 "")  
         (progn
           (setq T2 (getreal "\nAmount: "))
           (if T2
             (X_DATA_ADD EN APID
               (list (cons 1000 T1)
                     (cons 1040 T2)))))))))
;;---------------------------------------------------------
;
;  Edit description and amount data.
;
(defun EST_EDIT (APID / EN TMP T1 T2)
   (setq EN (car (entsel "\nSelect object: ")))
   (if (setq TMP (X_DATA_GET EN APID))
     (progn
        (setq T1
           (getstring 1
              (strcat "\nDescription <"
                      (cdar TMP) ">: "))
              T2
           (getreal
              (strcat "\nAmount <"
                      (rtos (cdadr TMP)) ">: "))
              TMP
               (list
                 (cons 1000 (if T1 T1 (cdar TMP)))
                 (cons 1040 (if T2 T2 (cdadr TMP))))
        )
        (X_DATA_ADD EN APID TMP))))
;;---------------------------------------------------------
;
; Remove estimator data
;
(defun EST_DEL (APID / EN)
  (setq EN (car (entsel "\nSelect object: ")))
  (if EN (X_DATA_DEL EN APID)))
;;---------------------------------------------------------
;
; Highlight all objects containing extended data
;
(defun EST_LOOK (APID / SS1 TMP)
  (setq SS1 (ssget "X" (list (list -3 (list APID)))))
  (if SS1
    (progn
       (setq TMP (sslength SS1))
       (repeat TMP
         (redraw
            (ssname
               SS1
               (setq TMP (1- TMP)))
            3)))))
;;---------------------------------------------------------
; Sum amount data and output to screen report
;
(defun EST_SUM (APID / TMP SUM SS1)
   (setq SS1 (ssget "X" (list (list -3 (list APID)))))
   (if SS1
     (progn
        (setq TMP (sslength SS1)
              SUM 0.0)
        (repeat TMP
           (setq TMP (1- TMP)
                 T1 (X_DATA_GET (ssname SS1 TMP) APID)
                 SUM (+ SUM (cdadr T1))))
        (prompt
          (strcat
             "\nSum total = "
             (rtos SUM))))))
[/php]