【KAIXIN】 发表于 2013-10-5 09:50:12

视口的图层解冻的VLA方法

下面是COMMAND的方法:

;解冻指定视口的指定图层 视口名（图元名），图层列表
;(xx-jdjd-name s1 lst)
(defun xx-jdjd-name (s1 lst)
(foreach x lst
    (if(and(member (cons 331 (tblobjname "layer" x)) (entget s1)))
      (command "_.vplayer" "t" x "s" s1 "" "")
    )
)
(princ)
)


是否可以用VLA方法来实现？

ysq101 发表于 2013-10-5 16:46:07

支持炫版主一下。。。。下面高手来说说

vectra 发表于 2013-10-5 21:06:58

FreezeLayersInViewport等同个函数都没有在ActiveX模型中公开嘛，好像没法搞了。

要么用vl-cmdf来代替command函数来安慰一下自己？

wxd20130610 发表于 2014-1-14 22:45:40

通过修改视口的扩展数据可以冻结图层

edata 发表于 2014-1-15 12:37:32

忘了出处。。。(defun c:test (/ lst ss)
(setq lst '("dim" "CENTER"))
(setq ss (ssget ":s" '((0 . "VIEWPORT"))))
(if ss
    (progn
      (FreezeLayersInViewPort (ssname ss 0) lst)
    )
    (princ "\n没有选择到视口。")
) ;if
(princ)
)
;;;;;;;;
(defun FreezeLayersInViewPort (en          lst               /
                             VPortObj          FrozenLayerList
                             count          pos               DataValueList
                             DataTypeList DataType       DataValue
                              )
(setq VPortObj (vlax-ename->vla-object en))
(setq FrozenLayerList (ax:GetFrozenLaysInVport VPortObj))
(setq count 0)
(foreach lay lst
    (if        (and (not (MEMBER lay FrozenLayerList)) (tblsearch "layer" lay))
      (progn
        (setq count (1+ count))
        (setq
          pos (vl-position (vlax-make-variant "}") DataValueList)
        )
        (setq DataValueList (append
                              (GetSubList DataValueList 0 (1- pos))
                              (list (vlax-make-variant lay vlax-vbString)
                              )
                              (GetSubList
                                DataValueList
                                pos
                                (1- (length DataValueList))
                              )
                          )
              DataTypeList(append
                              (GetSubList DataTypeList 0 (1- pos))
                              (list 1003)
                              (GetSubList
                                DataTypeList
                                pos
                                (1- (length DataTypeList))
                              )
                          )
        )
      )
    )
)
(if (> count 0)
    (progn
      (setq DataType (vlax-make-safearray
                     vlax-vbInteger
                     (cons 0 (1- (length DataTypeList)))
                     )
      )
      (vlax-safearray-fill DataType DataTypeList)
      (setq DataValue (vlax-make-safearray
                        vlax-vbVariant
                        (cons 0 (1- (length DataValueList)))
                      )
      )
      (vlax-safearray-fill DataValue DataValueList)
      (vla-SetXdata VPortObj DataType DataValue)
      (vla-update VPortObj)
      (vla-put-ViewPortOn VPortObj :vlax-false)
      (vla-put-ViewPortOn VPortObj :vlax-true)
      (princ (strcat "\n" (itoa count) "个图层已冻结。"))
    )
    (princ "\n没有图层被冻结。")
)

(princ)
)
;;得到视口中已冻结的图层列表
(defun ax:GetFrozenLaysInVport
       (VPortObj / ss TypeOut ValueOut tmp)
(vla-GetXdata VPortObj "" 'TypeOut 'ValueOut)
(setq        DataTypeList(vlax-safearray->list TypeOut)
        DataValueList (vlax-safearray->list ValueOut)
)
(setq tmp (mapcar 'cons DataTypeList DataValueList))
(mapcar 'vlax-variant-value
          (mapcar 'cdr
                  (vl-remove-if
                  '(lambda (x) (/= (car x) 1003))
                  tmp
                  )
          )
)
)
;;取得子表
(defun GetSubList (lst m n / i sublst)
(setq sublst '())
(if (and (>= m 0) (>= n 0) (>= n m) (<= n (1- (length lst))))
    (progn
      (setq i m)
      (repeat (1+ (- n m))
        (setq sublst (append sublst (list (nth i lst))))
        (setq i (1+ i))
      )
      sublst
    )
    nil
)
)

lingduwx 发表于 2014-1-15 14:24:40

顶一个，留个记号

鱼与熊掌 发表于 2015-1-14 14:01:42

借口代码，留名

curugi 发表于 2018-1-29 00:33:55

edata 发表于 2014-1-15 12:37
忘了出处。。。

好用吗好用吗好用吗

依然小小鸟 发表于 2019-2-22 14:17:32

不错的帖子 顶一下

KO你 发表于 2019-5-6 03:06:57

例如：解冻或冻结指定视口

(defun c:ra ();;指定视口解冻所有图层
(command "vplayer" "t" "*"))

(defun c:rr1 ();;指定视口冻结特定图层
(command "vplayer" "f" "Defpoints,地花,地花--尺寸,梁,墙 尺寸放线,天花 灯具尺寸,天花 灯具设备,天花 造型,天花 造型尺寸"))
页: [1] 2
查看完整版本: 视口的图层解冻的VLA方法