Vla-put-entitycolor

提供:GizmoLabs - だいたい CAD LISP なサイト
2016年1月14日 (木) 12:55時点におけるGizmon (トーク | 投稿記録)による版 (ページの作成:「{{AutoLISP}} ; 構文 : (vla-put-entitycolor ''vla-object'' ''color'') ; 機能 : True Color の色の値を指定する。 ; 引数 :* vla-object … AcCmColor の...」)
(差分) ← 古い版 | 最新版 (差分) | 新しい版 → (差分)
構文
(vla-put-entitycolor vla-object color)


機能
True Color の色の値を指定する。


引数
  • vla-object … AcCmColor のVLAオブジェクト
  • color … True Color の色の値。(長整数型)


戻り値
nil


  • MEMO :このプロパティは、色の 32 ビット AcCMEntityColor 部分を指定する。


サンプル
(vl-load-com)
(defun c:Example_EntityColor()
    ; 図形の色を変更するサンプル
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))

    (setq color (vlax-create-object "AutoCAD.AcCmColor.20")) ; バージョンに合わせる事
  
    (setq y (MakeLong (MakeWord 194 122) (MakeWord 133 144)))
    (vla-put-EntityColor color y)

    (setq modelSpace (vla-get-ModelSpace doc))
    (setq line (CreateLine))
    (vla-put-TrueColor line color)
    (setq retcolor (vla-get-TrueColor line))
    
    (setq x (vla-get-EntityColor retcolor))
    
    (setq BreakLong (vlax-make-safearray vlax-vbDouble '(0 . 3)))
    (vlax-safearray-put-element BreakLong 0 (logand x 255))
    (vlax-safearray-put-element BreakLong 1 (/ (logand x 65280) 256))
    (vlax-safearray-put-element BreakLong 2 (/ (logand x 16711680) 65536))
    (vlax-safearray-put-element BreakLong 3 (/ (logand x 2130706432) 16777216))

    (if (< x 0)
        (vlax-safearray-put-element BreakLong 3 (logior (fix (vlax-safearray-get-element BreakLong 3)) 128))
    )
    
    (alert (strcat "ColorMethod = " (itoa (fix (vlax-safearray-get-element BreakLong 3))) "\n"
                   "Red = " (itoa (fix (vlax-safearray-get-element BreakLong 2))) "\n"
                   "Green = " (itoa (fix (vlax-safearray-get-element BreakLong 1))) "\n"
                   "Blue = " (itoa (fix (vlax-safearray-get-element BreakLong 0)))))

    (vlax-release-object color)
)


(defun CreateLine()
    ; 線分を作成するサンプル
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))

    (setq startPoint (vlax-3d-point 1 1 0)
          endPoint (vlax-3d-point 5 5 0)) 

    (setq modelSpace (vla-get-ModelSpace doc))  
    (setq lineObj (vla-AddLine modelSpace startPoint endPoint))
    (vla-ZoomAll acadObj)
    lineObj
)

(defun MakeLong (WordHi WordLo)
   ;; 上位ワードは乗算でのオーバーフロー制限を回避するため
   ;; バリアント型に強制変換する。
   (+ (* WordHi 65536) (logand WordLo 65535))
)

(defun MakeWord(ByteHi ByteLo)
   ;; 上位バイトは、符号付き整数の範囲外の最終的な結果を
   ;; プッシュする場合、は、バック スライドする必要があるです。
   (if (> ByteHi 127)
      (- (+ (* ByteHi 256) ByteLo) 65536)
      (+ (* ByteHi 256) ByteLo)
   )
)

関連事項