Jump to content

Sharing ! XDATA function


AIberto

Recommended Posts

The following code sources from XDCAD.ORG , Author is Free-Lancer

 

;;Set xdata

 
;;Set xdata
;;bbs.xdcad.org
;;Author:Free-Lancer
(defun Obj:SetXdata (obj name lst / _prossList _setxdata nlst oldlst)
 (defun _prossList (lst / klst nlst)
   (setq klst '(("STRING" 1000)
                ("CTRL" 1002)
                ("LAYER" 1003)
                ("DADA" 1004)
                ("HANDLE" 1005)
                ("POSITION" 1010)
                ("LOCATION" 1011)
                ("DISPLACEMENT" 1012)
                ("DIRECTION" 1013)
                ("REAL" 1040)
                ("DISTANCE" 1041)
                ("SCALE" 1042)
                ("INTEGER" 1070)
                ("LONG" 1071)
               )
   )
   (mapcar
     '(lambda (x / key tf code)
        (setq key (car x)
              tf  (= (type key) 'STR)
        )
        (cond
          ((or        (member        key
                       '(1000 1002 1003 1004 1040 1041 1070 1071)
               )
               (and tf
                    (member (strcase key)
                            '("STRING"           "CTRL"      "LAYER"
                              "DATA"           "HANDLE"    "REAL"
                              "DISTANCE"  "SCALE"     "INTEGER"
                              "LONG"
                             )
                    )
               )
           )
           (if        tf
             (progn
               (setq code (cadr (assoc (strcase key) klst)))
               (mapcar        '(lambda (x)
                          (setq nlst (cons (cons code x) nlst))
                        )
                       (if (listp (cdr x))
                         (cdr x)
                         (list (cdr x))
                       )
               )
             )
             (mapcar '(lambda (a)
                        (setq nlst (cons (cons key a) nlst))
                      )
                     (if (listp (cdr x))
                       (cdr x)
                       (list (cdr x))
                     )
             ) ;_  string   Int real 必须区分, 符合组码
           )
          )
          ((or        (member        key
                       '(1010         1020        1030   1011   1021   1031
                         1012         1022        1032   1013   1023   1033
                        )
               )
               (and tf
                    (member (strcase key)
                            '("POSITION"
                              "LOCATION"
                              "DISPLACEMENT"
                              "DIRECTION"
                             )
                    )
               )
           )
           (if        tf
             (cond
               ((= (strcase key) "POSITION")
                (mapcar '(lambda (a)
                           (setq nlst (cons (cons 1010 a) nlst))
                         )
                        (cdr x)
                )
               )
               ((= (strcase key) "LOCATION")
                (mapcar
                  '(lambda (a)
                     (setq nlst (cons (cons 1011 a) nlst))
                   )
                  (cdr x)
                )
               )
               ((= (strcase key) "DISPLACEMENT")
                (mapcar
                  '(lambda (a)
                     (setq nlst (cons (cons 1012 a) nlst))
                   )
                  (cdr x)
                )
               )
               (t
                (mapcar
                  '(lambda (a)
                     (setq nlst (cons (cons 1013 a) nlst))
                   )
                  (cdr x)
                )
               )
             )
             (mapcar '(lambda (a)
                        (setq nlst (cons (cons key a) nlst))
                      )
                     (if (listp (cdr x))
                       (cdr x)
                       (list (cdr x))
                     )
             )
           )
          )
          (t)
        )
      )
     lst
   )
   nlst
 )
 (defun _setXdata (obj lst /)
   (vla-setxdata
     obj
     (list->vbarray (mapcar 'car lst) vlax-vbinteger)
     (list->vbarray (mapcar 'cdr lst) vlax-vbvariant)
   )
 )
 ;;main
 (setq nlst (_prossList lst))
 (if (member (strcase name)
             (mapcar 'strcase (obj:getxdataname obj))
     )
   (setq oldlst (obj:GetXdata obj name)
         nlst         (append oldlst nlst)
   )
 )
 (if (= (type obj) 'ENAME)
   (setq obj (vlax-ename->vla-object obj))
 )
 (_setXdata obj (cons (cons 1001 name) nlst))
 t
)

 

;;Remove Xdata

;;Remove Xdata
;;bbs.xdcad.org
;;Author:Free-Lancer
(defun Obj:RemoveXdata (obj        name        values        /        _setXdata
                       xlst        xt        xd        xdlst        xtlst        nxtlst
                       nxlst        var
                      )
 (defun _setXdata (obj lst /)
   (vla-setxdata
     obj
     (list->vbarray (mapcar 'car lst) vlax-vbinteger)
     (list->vbarray (mapcar 'cdr lst) vlax-vbvariant)
   )
 )
 (if (= (type obj) 'ENAME)
   (setq obj (vlax-ename->vla-object obj))
 )
 (if (member (strcase name)
             (mapcar 'strcase (obj:getxdataname obj))
     )
   (progn
     (if (or (null values) (= values T))
       (_setXdata obj (list (cons 1001 name)))
       (progn
         (vla-getxdata obj name 'xt 'xd)
         (setq        xlst  (mapcar 'variant-value (safearray-value xd))
               xtlst (safearray-value xt)
         )
         (if (apply 'or (mapcar '(lambda (x) (member x xlst)) values))
           (progn
             (while xlst
               (if (not (vl-member-if
                          '(lambda (x)
                             (equal (car xlst) x 1e-3)
                           )
                          values
                        )
                   )
                 (setq        nxlst  (cons (car xlst) nxlst)
                       values (vl-remove (car xlst) values)
                       nxtlst (cons (car xtlst) nxtlst)
                 )
               )
               (setq xlst  (cdr xlst)
                     xtlst (cdr xtlst)
               )
             )
             (if nxlst
               (_setXdata obj
                          (mapcar '(lambda (x y) (cons x y))
                                  (reverse nxlst)
                                  (reverse nxtlst)
                          )
               )
             )
           )
         )
       )
     )
     t
   )
 )
)

 

;;Remove Xdata

;; Replace xdata
;;bbs.xdcad.org
;;Author:Free-Lancer
(defun obj:ReplaceXdata        (obj           name             oldvars   newvars
                        /           _replace  _setxdata nl
                       )
 (defun _setXdata (obj lst /)
   (vla-setxdata
     obj
     (list->vbarray (mapcar 'car lst) vlax-vbinteger)
     (list->vbarray (mapcar 'cdr lst) vlax-vbvariant)
   )
 )
 (defun _replace (obj name old new / xd xt xtlst xdlst nlst tf)
   (vla-getxdata obj name 'xt 'xd)
   (setq xtlst        (safearray-value xt)
         xdlst        (mapcar 'variant-value (safearray-value xd))
   )
   (while xdlst
     (if (member (car xdlst) old)
       (setq
         nlst (cons (nth (vl-position (car xdlst) old)
                         new
                    )
                    nlst
              )
         tf   t
       )
       (setq nlst (cons (car xdlst) nlst))
     )
     (setq xdlst (cdr xdlst))
   )
   (if        tf
     (_setxdata
       obj
       (mapcar '(lambda (x y) (cons x y)) xtlst (reverse nxdlst))
     )
   )
 )
 (if (setq nl (obj:getxdataname obj))
   (if        (or (= name "*") (= name T))
     (foreach x nl
       (_replace obj x oldvars newvars)
     )
     (if (member (strcase name) (mapcar 'strcase nl))
       (_replace obj name oldvars newvars)
     )
   )
 )

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...