诡异的视口，让我摸不着头脑，求助。

mokson · 发表于 2023-2-24 18:47:30

感谢各大佬们的指点，现在搞定了。

cq4920 · 发表于 2023-2-24 18:48:37

(defun c:FE ()(command "LAYFRZ" ));冻结关闭视口内图层
;;;打开视口内所有图层
(defun c:fr (/ ssent laList i)
(if (= (getvar "tilemode") 1)
(setvar "tilemode" 0)
)
(if (/= (getvar "cvport") 1)
(command "_PSPACE")
)
(if (setq ssent (ssget '((0 . "VIEWPORT"))))
(progn
(setq i 0)
(repeat (sslength ssent)
(if (/= ""
(setq laList (LA:GetFreezeLayerForView
(vlax-ename->vla-object (ssname ssent i))
)
)
)
(command "_.vplayer" "T" laList "S" (ssname ssent i) "" "")
)
(setq i (1+ i))
)
)
)
(princ)
)
(defun LA:GetFreezeLayerForView (VpObj / xt xd lyrlst a b)
(vla-getxdata VpObj "ACAD" 'xt 'xd)
(mapcar 'set
'(xt xd)
(list (safearray-value xt) (safearray-value xd))
)
(setq lyrlst "")
(mapcar '(lambda (a b)
(if (= a 1003)
(setq lyrlst (strcat lyrlst (strcase (variant-value b)) ","))
)
)
xt
xd
)
lyrlst
)
;;;;====================图层工具===================================
; 隔离图层，选择层除外，关闭其它所有层
(defun c:r1(/ x)
(vl-cmdf "LAYISO" "s" "o" "o" )
(princ )
)
; *打开所有层
(defun c:r2( / )
(vl-cmdf "layer" "on" "*" "")
(princ )
)
(defun c:r3(/ x)
(IF (setq e (car(entsel"\n选择对象关闭所在图层")))
(progn
(setq lay (cdr(assoc 8 (entget e))))
(cond
((and (= lay (getvar "CLAYER")) (/= lay "0"))
(progn
(setvar "CLAYER" "0")
(vla-put-layeron(vlax-ename->vla-object(tblobjname "LAYER" lay)):vlax-false)
)
)
((/= lay (getvar "CLAYER"))
(vla-put-layeron(vlax-ename->vla-object(tblobjname "LAYER" lay)):vlax-false)
)
((and (= lay (getvar "CLAYER")) (= lay "0"))
(princ"当前图层和对象图层都在0层，请重新执行")
)
)
)
)
(princ)
)
(defun c:r4(/ x)
(vl-cmdf "LAYvpi" )
(princ )
)

(defun c:FE ()(command "LAYFRZ" ));冻结关闭视口内图层 
 
;;;打开视口内所有图层 
(defun c:fr (/ ssent laList i) 
 
  (if (= (getvar "tilemode") 1) 
    (setvar "tilemode" 0) 
  ) 
  (if (/= (getvar "cvport") 1) 
    (command "_PSPACE") 
  ) 
  (if (setq ssent (ssget '((0 . "VIEWPORT")))) 
    (progn 
      (setq i 0) 
      (repeat (sslength ssent) 
        (if (/=        "" 
              (setq laList (LA:GetFreezeLayerForView 
         (vlax-ename->vla-object (ssname ssent i)) 
       ) 
              ) 
            ) 
          (command "_.vplayer" "T" laList "S" (ssname ssent i) "" "") 
        ) 
        (setq i (1+ i)) 
      ) 
    ) 
  ) 
  (princ) 
) 
(defun LA:GetFreezeLayerForView  (VpObj / xt xd lyrlst a b) 
  (vla-getxdata VpObj "ACAD" 'xt 'xd) 
  (mapcar 'set 
    '(xt xd) 
    (list (safearray-value xt) (safearray-value xd)) 
  ) 
  (setq lyrlst "") 
  (mapcar '(lambda (a b) 
             (if (= a 1003) 
               (setq lyrlst (strcat lyrlst (strcase (variant-value b))  ",")) 
             ) 
           ) 
    xt 
    xd 
  ) 
  lyrlst 
) 
 
;;;;====================图层工具=================================== 
;        隔离图层，选择层除外，关闭其它所有层 
(defun c:r1(/ x) 
        (vl-cmdf "LAYISO" "s" "o" "o" ) 
        (princ ) 
) 
;        *打开所有层 
(defun c:r2( / ) 
        (vl-cmdf "layer" "on" "*" "") 
        (princ ) 
) 
(defun c:r3(/ x) 
        (IF (setq e (car(entsel"\n选择对象关闭所在图层"))) 
                (progn 
                        (setq lay (cdr(assoc 8 (entget e)))) 
                        (cond 
                                ((and (= lay (getvar "CLAYER")) (/= lay "0")) 
                                        (progn 
                                                (setvar "CLAYER" "0") 
                                                (vla-put-layeron(vlax-ename->vla-object(tblobjname "LAYER" lay)):vlax-false) 
                                        ) 
                                ) 
                                ((/= lay (getvar "CLAYER")) 
                                        (vla-put-layeron(vlax-ename->vla-object(tblobjname "LAYER" lay)):vlax-false) 
                                ) 
                                ((and (= lay (getvar "CLAYER")) (= lay "0")) 
                                        (princ"当前图层和对象图层都在0层，请重新执行") 
                                ) 
                        ) 
                ) 
        ) 
        (princ) 
) 
(defun c:r4(/ x) 
        (vl-cmdf "LAYvpi" ) 
        (princ ) 
)

依然小小鸟 · 发表于 2023-2-25 09:02:10

不错的帖子顶一下

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

[提问] 诡异的视口，让我摸不着头脑，求助。