视口内冻结图层问题

q3_2006

(progn
(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)
    )
  )
)
)
这是E版的视口内解冻图层的代码..但我的这个图里有个网格层..无法用代码解冻..不知道是什么原因..请高手帮忙测试一下..谢谢

q3_2006

补充一句..其它图层是能解冻的..唯一就这个图层不能哈..网格

q3_2006

另外我不太明白..解冻为什么要删除原视口..

q3_2006

找到问题了...网格图层设置了视口内冻结..

q3_2006

现在请大师来解决我的疑问..不能只更新不删除吗...CAD里操作后句柄没有变化的..可见没有删除原视口

newer

命令: (setq a (xdrx_getpropertyvalue e "FrozenLayerList"))
(("网格" <图元名: 7ff72670dad0>))

命令: (xdrx_setpropertyvalue e "thawlayersinviewport" a)

1. (defun c:tt ()
   
2.   (if (and (setq e (car (entsel "\n拾取视口")))
   
3.            (setq lst (xdrx_getpropertyvalue e "FrozenLayerList"))
   
4.       )
   
5.     (progn (xdrx_setpropertyvalue e "thawlayersinviewport" lst))
   
6.   )
   
7.   (princ)
   
8. )
   

(defun c:tt ()<br />   (if (and (setq e (car (entsel "\n拾取视口")))<br />            (setq lst (xdrx_getpropertyvalue e "FrozenLayerList"))<br />       )<br />     (progn (xdrx_setpropertyvalue e "thawlayersinviewport" lst))<br />   )<br />   (princ)<br /> )<br />

q3_2006

newer 发表于 2017-12-29 14:28

如果版本低于2011呢

csharp

q3_2006 发表于 2017-12-29 14:13

autolisp 和 ActiveX 没有提供更新的方法，只能重建（ARX 和 C#除外）

q3_2006

csharp 发表于 2017-12-29 14:38

这样呀..知道了..谢谢哈..

newer

q3_2006 发表于 2017-12-29 14:35

上面代码和低于2011有什么关系吗? 只要能加载API的，就能执行。

q3_2006

newer 发表于 2017-12-29 14:40

好..明白..

kqqt6236

学习了。         

zteykmgscqh

学习了，谢谢楼主提供的源码