Vla-get-allowedvalues

AutoLISP Home - AutoLISP 目次 - DCL - AutoLisp関数互換表 - CAD&CGブログ - オンラインショップ- GizmoTools ヘルプセンター

構文: (vla-get-allowedvalues vla-object)

機能: プロパティに許される値を取得する。

引数

vla-object … DynamicBlockReferenceProperty のVLAオブジェクト

戻り値: プロパティの値。

MEMO: ダイナミックブロックのプロパティの中には制限のないものや、最大、最小値(または、その両方)を指定したり、有効な値の許可リストがあるものがある。このプロパティは、許可リストで定義されているプロパティ値のみをサポートしていて、最小値、最大値、および制限のないプロパティは、サポートしていない。

サンプル

;;;  ツール パレットまたはデザイン センターからブロックをドラッグして挿入すると割り込みでブロック挿入のパラメーターと属性を要求するサンプル。
;;;  特定のプロンプトを表示する問題を回避するため通常の属性プロンプトをオフにします。
;;;  ルーチンは、プロパティ パレットに表示されない任意のパラメーターを除外します。
;;;*******************************************************************
;;;support functions
(vl-load-com)
;;;*******************************************************************
(defun ss->objlist (ss / cnt objlist)
  (setq cnt (sslength ss))
  (repeat cnt
    (setq objlist (append objlist (list (vlax-ename->vla-object (ssname ss (- cnt 1))))))
    (setq cnt (- cnt 1)) )
  (setq ss nil)
  objlist)

;;;callback functions
(defun gp:binsertatts (a b / ss obj objattr nwstr)
  (if (or (eq (car b) "EXECUTETOOL") (eq (car b) "DROPGEOM") (eq (car b) "INSERT") (eq (car b) "-INSERT"))
    (setvar "attreq" 0)
  ))

(defun gp:binsertatte (a b / ss obj objattr nwstr objdyn newvalue prmpts cnt dyn dynp)
  (if (or (eq (car b) "EXECUTETOOL") (eq (car b) "DROPGEOM") (eq (car b) "INSERT") (eq (car b) "-INSERT"))
    (progn
      (setq dyn (getvar "dynmode"))
      (setq dynp (getvar "dynprompt"))
      (setvar "dynprompt" 1)
      (setvar "dynmode" 1)
      (setq ss (ssget "L"))
      (setq obj (ss->objlist ss))
      (foreach o obj
        (if (= (cdr (assoc 0 (entget (vlax-vla-object->ename o)))) "INSERT")
          (progn
            (if (= (vla-get-HasAttributes o) :vlax-true)
              (progn
                (setq objattr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes o))))
                (foreach oa objattr
                  (setq oatr oa)
                  (if (= (vla-get-Constant oa) :vlax-false)
                    (progn
                      (setq nwstr (getstring (strcat "\n" (vla-get-TagString oa) "を入力 : <" (vla-get-TextString oa) ">: ")))
                      (if (/= nwstr "") (vla-put-TextString oa nwstr))
                      (setq nwstr nil)
                    )))))
            (if (= (vla-get-IsDynamicBlock o) :vlax-true)
              (progn
                (setq objdyn (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties o))))
                (foreach od objdyn
                  (if (and (= (vla-get-Show od) :vlax-true) (= (vla-get-ReadOnly od) :vlax-false) (/= (vla-get-PropertyName od) "Origin"))
                    (progn
                      (if (= (vlax-safearray-get-u-bound (vlax-variant-value (vla-get-AllowedValues od)) 1) -1)
                        (progn
                          (if (= (vla-get-Description od) "")
                            (setq prmpts (strcat "\n " (vla-get-PropertyName od) "の値を入力 :"))
                            (setq prmpts (strcat "\n " (vla-get-Description od) "の値を入力 :"))
                          )
                          (cond
                            ((= (vla-get-UnitsType od) acAngular) (setq newvalue (getorient prmpts)))
                            ((= (vla-get-UnitsType od) acDistance) (setq newvalue (getdist prmpts)))
                            ((= (vla-get-UnitsType od) acArea) (setq newvalue (getreal prmpts)))
                          )
                          (if (/= newvalue nil) (vla-put-Value od (vlax-make-variant newvalue)))
                        )
                        (progn
                          (setq prmpts "[")
                          (setq cnt 1)
                          (foreach pt (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))
                            (if (= (vla-get-UnitsType od) acNoUnits)
                              (if (numberp (vlax-variant-value pt))
                                (if (= (vlax-variant-value pt) 0)
                                  (setq prmpts (strcat prmpts (itoa cnt) ").NotFlipped "))
                                  (setq prmpts (strcat prmpts (itoa cnt) ").Flipped "))
                                )
                                (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (vlax-variant-value pt))) " "))
                              )
                              (setq prmpts (strcat prmpts (itoa cnt) ")." (vl-string-translate "/" "|" (vl-string-translate " " "-" (rtos (vlax-variant-value pt)))) " "))
                            )
                            (setq cnt (+ cnt 1))
                          )
                          (setq prmpts (strcat (vl-string-right-trim " " prmpts) "]"))
                          (initget 0 (vl-string-trim "[]" prmpts))
                          (if (= (vla-get-Description od) "")
                            (setq newvalue (getkword (strcat "\n " (vla-get-PropertyName od) "の値を入力 :" (vl-string-translate " " "/" prmpts))))
                            (setq newvalue (getkword (strcat "\n " (vla-get-Description od) "の値を入力 :" (vl-string-translate " " "/" prmpts))))
                          )
                          (if (/= newvalue nil)
                            (progn
                              (setq newvalue (nth (- (atoi (substr newvalue 1 (vl-string-position 41 newvalue))) 1) (vlax-safearray->list (vlax-variant-value (vla-get-AllowedValues od)))))
                              (vla-put-Value od newvalue)
                            ))))))))))))
      (setvar "dynmode" dyn)
      (setvar "dynprompt" dynp)
    )
  )
  (setvar "attreq" 1)
  (princ)
);_end_defun

;;;*******************************************************************
;;;reactors
(setq rinsrte (vlr-command-reactor nil '((:vlr-commandEnded . gp:binsertatte))))
(setq rinsrts (vlr-command-reactor nil '((:vlr-commandWillStart . gp:binsertatts))))