视口的图层解冻的VLA方法

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

下面是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

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

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

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

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

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

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

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

忘了出处。。。

(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
)
)

(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

顶一个，留个记号

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

借口代码，留名

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

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

好用吗好用吗好用吗

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

不错的帖子顶一下

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

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

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

(defun c:rr1 ();;指定视口冻结特定图层
(command "vplayer" "f" "Defpoints,地花,地花--尺寸,梁,墙尺寸放线,天花灯具尺寸,天花灯具设备,天花造型,天花造型尺寸"))

账号		自动登录	找回密码
密码			注册

[讨论] 视口的图层解冻的VLA方法

本帖被以下淘专辑推荐:

浏览过的版块