视口冻结解冻图层列表如何使用

magicheno · 发表于 2021-7-7 23:20:10

本帖最后由 magicheno 于 2021-7-7 23:23 编辑

这下面是晓东里复制过来的，下面的函数就是不知道怎么用，有没有大佬指教下，该如何使用呢
明经里有一个帖子好像只有一种全部视口解冻的用法
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175737&highlight=%B6%B3%BD%E1%2B%C1%D0%B1%ED
(vp:frzlayer (vlax-ename->vla-object (car (entsel))) '("center" "dim"));冻结图层
(vp:thwlayer (vlax-ename->vla-object (car (entsel))) '("center" "dim"));解冻图层
(vp:getfrzlayer (vlax-ename->vla-object (car (entsel))));_获取冻结图层列表

;;Author: eachy from www.xdcad.net 2013.10.9
(defun Vp:GetXdata (Vpobj / xt xd)
(vla-getxdata VpObj "ACAD" 'xt 'xd)
(list (safearray-value xt) (safearray-value xd))
)
(defun Vp:SetXdata (Vpobj xtype xdata /)
(vla-setxdata
VpObj
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbInteger
(cons 0 (1- (length xtype)))
)
xtype
)
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbvariant
(cons 0 (1- (length xdata)))
)
xdata
)
)
(vla-update VpObj)
(vla-display VpObj :vlax-false)
(vla-display VpObj :vlax-true)
)
(defun Vp:GetxdataFrzlyr (xt xd / lyrlst)
(mapcar '(lambda (a b)
(if (= a 1003)
(setq lyrlst (cons (strcase (variant-value b)) lyrlst))
)
)
xt
xd
)
lyrlst
)
(defun vp:PutFrzLyr (xt xd lyrlst / xtt xdd flyr l)
(if lyrlst
(progn (setq xt (reverse (vl-remove 1003 xt))
xd (reverse xd)
l (list (car xd) (cadr xd))
xd (vl-member-if
'(lambda (x) (equal (variant-value x) "{"))
(cddr xd)
)
xd (append l xd)
)
(setq flyr (mapcar '(lambda (x)
(list 1003
(vlax-make-variant x vlax-vbstring)
)
)
lyrlst
)
xtt (reverse (append (list (car xt) (cadr xt))
(mapcar 'car flyr)
(cddr xt)
)
)
xdd (reverse (append (list (car xd) (cadr xd))
(mapcar 'cadr flyr)
(cddr xd)
)
)
)
(list xtt xdd)
)
(if (member 1003 xt)
(progn (setq xt (reverse (vl-remove 1003 xt))
xd (reverse xd)
l (list (car xd) (cadr xd))
xd (vl-member-if
'(lambda (x) (equal (variant-value x) "{"))
(cddr xd)
)
xd (append l xd)
)
(list (reverse xt) (reverse xd))
)
(list xt xd)
)
)
)
;;
(defun Vp:GetFrzLayer (VpObj / xt xd)
(mapcar 'set '(xt xd) (vp:getxdata vpobj))
(vp:getxdataFrzlyr xt xd)
)
(defun Vp:Frzlayer (VpObj lyrlst / xd xt oldlyrlst xdata llyrlst)
(mapcar 'set '(xt xd) (vp:getxdata vpobj))
(if lyrlst
(progn
(setq lyrlst (mapcar 'strcase lyrlst))
(if (setq oldlyrlst (vp:getxdatafrzlyr xt xd)
llyrlst oldlyrlst
)
(mapcar '(lambda (x)
(if (not (member x oldlyrlst))
(setq oldlyrlst (append (list x) oldlyrlst))
)
)
lyrlst
)
(setq oldlyrlst lyrlst)
)
(if (not (equal oldlyrlst llyrlst))
(progn
(setq xdata (vp:putfrzlyr xt xd oldlyrlst))
(Vp:SetXdata Vpobj (car xdata) (cadr xdata))
)
)
)
)
)
(defun Vp:ThwLayer
(VpObj lyrlst / properties pSp nVp oldFrzlyr lfrzlyr xt xd)
(mapcar 'set '(xt xd) (vp:getxdata vpobj))
(setq oldFrzlyr (vp:getxdatafrzlyr xt xd)
lfrzlyr oldfrzlyr
)
(mapcar '(lambda (x) (setq oldfrzlyr (vl-remove x oldFrzlyr)))
(mapcar 'strcase lyrlst)
)
(if (not (equal oldfrzlyr lfrzlyr))
(progn
(setq properties
'("CustomScale" "Direction" "DisplayLocked"
"GridOn" "Layer" "LensLength"
"Linetype" "LinetypeScale" "Lineweight"
"SnapBasePoint" "SnapOn" "SnapRotationAngle"
"StandardScale" "StandardScale2" "Target"
"TrueColor" "TwistAngle" "UCSIconAtOrigin"
"UCSIconOn" "ViewportOn" "Visible"
)
)
(mapcar '(lambda (x)
(if (vlax-property-available-p VpObj x)
(set (read x) (vlax-get-property VpObj x))
)
)
properties
)
(setq pSp (vla-get-PaperSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
nVp (vla-AddPViewport
pSp
(vla-get-center VpObj)
(vla-get-width VpObj)
(vla-get-height VpObj)
)
)
(setq xdata (vp:putfrzlyr xt xd oldFrzlyr))
(Vp:SetXdata nVp (car xdata) (cadr xdata))
(mapcar '(lambda (x)
(if (eval (read x))
(vl-catch-all-apply
'vlax-put-property
(list nVp x (eval (read x)))
)
)
)
properties
)
(mapcar '(lambda (x) (set (read x) nil)) properties)
(vla-delete vpobj)
)
)
)

;;Author: eachy from www.xdcad.net 2013.10.9 
(defun Vp:GetXdata (Vpobj / xt xd) 
  (vla-getxdata VpObj "ACAD" 'xt 'xd) 
  (list (safearray-value xt) (safearray-value xd)) 
) 
(defun Vp:SetXdata (Vpobj xtype xdata /) 
  (vla-setxdata 
    VpObj 
    (vlax-safearray-fill 
      (vlax-make-safearray 
    vlax-vbInteger 
    (cons 0 (1- (length xtype))) 
      ) 
      xtype 
    ) 
    (vlax-safearray-fill 
      (vlax-make-safearray 
    vlax-vbvariant 
    (cons 0 (1- (length xdata))) 
      ) 
      xdata 
    ) 
  ) 
  (vla-update VpObj) 
  (vla-display VpObj :vlax-false) 
  (vla-display VpObj :vlax-true) 
) 
(defun Vp:GetxdataFrzlyr (xt xd / lyrlst) 
  (mapcar '(lambda (a b) 
         (if (= a 1003) 
           (setq lyrlst (cons (strcase (variant-value b)) lyrlst)) 
         ) 
       ) 
      xt 
      xd 
  ) 
  lyrlst 
) 
(defun vp:PutFrzLyr (xt xd lyrlst / xtt xdd flyr l) 
  (if lyrlst 
    (progn (setq xt (reverse (vl-remove 1003 xt)) 
         xd (reverse xd) 
         l  (list (car xd) (cadr xd)) 
         xd (vl-member-if 
              '(lambda (x) (equal (variant-value x) "{")) 
              (cddr xd) 
            ) 
         xd (append l xd) 
       ) 
       (setq flyr (mapcar '(lambda (x) 
                 (list 1003 
                       (vlax-make-variant x vlax-vbstring) 
                 ) 
                   ) 
                  lyrlst 
              ) 
         xtt  (reverse (append (list (car xt) (cadr xt)) 
                       (mapcar 'car flyr) 
                       (cddr xt) 
                   ) 
              ) 
         xdd  (reverse (append (list (car xd) (cadr xd)) 
                       (mapcar 'cadr flyr) 
                       (cddr xd) 
                   ) 
              ) 
       ) 
       (list xtt xdd) 
    ) 
    (if    (member 1003 xt) 
      (progn (setq xt (reverse (vl-remove 1003 xt)) 
           xd (reverse xd) 
           l  (list (car xd) (cadr xd)) 
           xd (vl-member-if 
            '(lambda (x) (equal (variant-value x) "{")) 
            (cddr xd) 
              ) 
           xd (append l xd) 
         ) 
         (list (reverse xt) (reverse xd)) 
      ) 
      (list xt xd) 
    ) 
  ) 
) 
;; 
(defun Vp:GetFrzLayer (VpObj / xt xd) 
  (mapcar 'set '(xt xd) (vp:getxdata vpobj)) 
  (vp:getxdataFrzlyr xt xd) 
) 
(defun Vp:Frzlayer (VpObj lyrlst / xd xt oldlyrlst xdata llyrlst) 
  (mapcar 'set '(xt xd) (vp:getxdata vpobj)) 
  (if lyrlst 
    (progn 
      (setq lyrlst (mapcar 'strcase lyrlst)) 
      (if (setq    oldlyrlst (vp:getxdatafrzlyr xt xd) 
        llyrlst      oldlyrlst 
      ) 
    (mapcar    '(lambda (x) 
           (if (not (member x oldlyrlst)) 
             (setq oldlyrlst (append (list x) oldlyrlst)) 
           ) 
         ) 
        lyrlst 
    ) 
    (setq oldlyrlst lyrlst) 
      ) 
      (if (not (equal oldlyrlst llyrlst)) 
    (progn 
      (setq xdata (vp:putfrzlyr xt xd oldlyrlst)) 
      (Vp:SetXdata Vpobj (car xdata) (cadr xdata)) 
    ) 
      ) 
    ) 
  ) 
) 
(defun Vp:ThwLayer 
       (VpObj lyrlst / properties pSp nVp oldFrzlyr lfrzlyr xt xd) 
  (mapcar 'set '(xt xd) (vp:getxdata vpobj)) 
  (setq    oldFrzlyr (vp:getxdatafrzlyr xt xd) 
    lfrzlyr      oldfrzlyr 
  ) 
  (mapcar '(lambda (x) (setq oldfrzlyr (vl-remove x oldFrzlyr))) 
      (mapcar 'strcase lyrlst) 
  ) 
  (if (not (equal oldfrzlyr lfrzlyr)) 
    (progn 
      (setq properties 
         '("CustomScale"      "Direction"         "DisplayLocked" 
           "GridOn"          "Layer"         "LensLength" 
           "Linetype"      "LinetypeScale"    "Lineweight" 
           "SnapBasePoint"      "SnapOn"         "SnapRotationAngle" 
           "StandardScale"      "StandardScale2"   "Target" 
           "TrueColor"      "TwistAngle"         "UCSIconAtOrigin" 
           "UCSIconOn"      "ViewportOn"         "Visible" 
          ) 
      ) 
      (mapcar '(lambda (x) 
         (if (vlax-property-available-p VpObj x) 
           (set (read x) (vlax-get-property VpObj x)) 
         ) 
           ) 
          properties 
      ) 
      (setq pSp    (vla-get-PaperSpace 
          (vla-get-ActiveDocument 
            (vlax-get-acad-object) 
          ) 
        ) 
        nVp    (vla-AddPViewport 
          pSp 
          (vla-get-center VpObj) 
          (vla-get-width VpObj) 
          (vla-get-height VpObj) 
        ) 
      ) 
      (setq xdata (vp:putfrzlyr xt xd oldFrzlyr)) 
      (Vp:SetXdata nVp (car xdata) (cadr xdata)) 
      (mapcar '(lambda (x) 
         (if (eval (read x)) 
           (vl-catch-all-apply 
             'vlax-put-property 
             (list nVp x (eval (read x))) 
           ) 
         ) 
           ) 
          properties 
      ) 
      (mapcar '(lambda (x) (set (read x) nil)) properties) 
      (vla-delete vpobj) 
    ) 
  ) 
)

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

[提问] 视口冻结解冻图层列表如何使用