리습 강좌 - ActiveX를 이용한 Xdata 입력함수, Xdata 얻기함수.

본 강좌는 아키오피스(김희태)에 의해 만들어 졌으며 어떠한 웹이나
출판물에 아키오피스(김희태)의 동의없이 올리는 것을 허락하지 않습니다.

 

activex 를 이용한 xdata 를 입력하거나 얻는 함수입니다.
kht:SetXData 는 xdata를 object 에 입력하는 함수이고
kht:GetXData 는 object 가 가지고 있는 xdata를 얻는하는 함수입니다.


(kht:SetXData (vlax-ename->vla-object (car (entsel))) "kht1" '(1070 . 200))

=> 해당 object 에 appid kht1 의 xdata (1070 . 200) 를 입력한다.

(kht:GetXData (vlax-ename->vla-object (car (entsel))) "kht1")

=> ((1001 . "kht1") (1070 . 200)) 리턴 , xdata가 없는 object 는 nil 리턴

코드

  
  (defun kht:GetXData (Obj App / FldLst ValLst Xd_Fld Xd_Val)
    (vla-GetXData Obj App 'Xd_Fld 'Xd_Val)
    (if (and Xd_Fld Xd_Val)
      (setq FldLst (vlax-safearray->list Xd_Fld)
            ValLst (mapcar 'vlax-variant-value
                     (vlax-safearray->list Xd_Val)
                   )
      )
    )
    (mapcar '(lambda (f v) (cons f v)) FldLst ValLst)
  )

  (defun kht:SetXData (Obj App dat / ex typarr datarr  errcat)
    (if (setq ex (VxGetXData obj app))
      (if (assoc (car dat) ex)
        (setq ex (subst dat (assoc (car dat) ex) ex))
        (setq ex (append ex (list dat)))
      )
      (setq ex (list (cons 1001 app) dat))
    )
    (setq typarr (vlax-make-safearray vlax-vbinteger (cons 0  (1- (length ex)))))
    (setq datarr (vlax-make-safearray vlax-vbvariant (cons 0  (1- (length ex)))))
    (and
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          (type (setq errcat (vl-catch-all-apply 'vlax-safearray-fill (list typarr (mapcar 'car ex))))))
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          (type (setq errcat (vl-catch-all-apply 'vlax-safearray-fill (list datarr (mapcar 'cdr ex))))))
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          (type (setq errcat (vl-catch-all-apply 'vla-setxdata (list obj typarr datarr)))))
    )
    (if (vl-catch-all-error-p errcat)
      (princ (strcat "\n Function \"VxSetXData\" error->: " (vl-catch-all-error-message errcat)))
    )
  )
설명
  ;; object 에서 xdata 를 얻는 함수입니다.
  (defun kht:GetXData (Obj App / FldLst ValLst Xd_Fld Xd_Val)
    ;; object 에서 해당 app 의 xdata 를 Xd_Fld, Xd_Val 로 저장합니다.
    (vla-GetXData Obj App 'Xd_Fld 'Xd_Val)
    ;; xdata 가 있다면
    (if (and Xd_Fld Xd_Val)
      ;; 배열을 리스트로 변환하여
      (setq FldLst (vlax-safearray->list Xd_Fld)
            ValLst (mapcar 'vlax-variant-value
                     (vlax-safearray->list Xd_Val)
                   )
      )
    )
    ;; 코드별로 묶어서 리턴합니다.
    (mapcar '(lambda (f v) (cons f v)) FldLst ValLst)
  )


  ;; xdata 를 object 에 입력하는 함수입니다.
  (defun kht:SetXData (Obj App dat / ex typarr datarr  errcat)
    ;; VxGetXData 함수로 해당 object 의 xdata를 얻어서
    (if (setq ex (VxGetXData obj app))
      ;; 그 xdata 에 입력하려는 data 가 존재하면
      (if (assoc (car dat) ex)
        ;; 새로운 data로 교체하고
        (setq ex (subst dat (assoc (car dat) ex) ex))
        ;; 입력하려는 data가 없다면 기존 xdata 리스트에 추가 합니다.
        (setq ex (append ex (list dat)))
      )
      ;; object 에 xdata 가 없다면 새로운 xdata 리스트를 만듭니다.
      ;; activex 에서 appid 는 1001 에 해당합니다.
      (setq ex (list (cons 1001 app) dat))
    )
    ;; xdata 를 입력할 배열을 선언합니다.
    (setq typarr (vlax-make-safearray vlax-vbinteger (cons 0  (1- (length ex)))))
    (setq datarr (vlax-make-safearray vlax-vbvariant (cons 0  (1- (length ex)))))
    ;; 일반리습함수에서 error 가 발생하면 그냥 error 메세지를 출력하고 종료하지만
    ;; axtivex 함수중 error 가 발생하면 object 가 그냥 사라지는등 예상치못한 문제가 발생합니다.
    ;; 이를위해 vl-catch-all-apply,vl-catch-all-error-message,vl-catch-all-error-p 함수가 있습니다.
    ;; 자세한 사용법은 도움말을 이용하세요.
    ;; (kht:SetXData (vlax-ename->vla-object (car (entsel))) "kht1" '("ABC" . 200)) 
    ;; "ABC" 는 DXF 코드가 아니므로 이렇게 하면 에러가 발생하겠죠. 
    ;; 그럼 에러를 잡아서 에러메세지를 출력하고 종료됩니다.
    (and
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          ;; dxf 코드리스트를 변수에 저장
          (type (setq errcat (vl-catch-all-apply 'vlax-safearray-fill (list typarr (mapcar 'car ex))))))
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          ;; 해당 값리스트를 변수에 저장
          (type (setq errcat (vl-catch-all-apply 'vlax-safearray-fill (list datarr (mapcar 'cdr ex))))))
      (/= 'VL-CATCH-ALL-APPLY-ERROR
          ;; vla-setxdata 로 object 에 xdata 입력
          (type (setq errcat (vl-catch-all-apply 'vla-setxdata (list obj typarr datarr)))))
    )
    ;; 만약 에러가 발생하면 에러메세지를 출력하고 종료...
    (if (vl-catch-all-error-p errcat)
      (princ (strcat "\n Function \"VxSetXData\" error->: " (vl-catch-all-error-message errcat)))
    )
  )