视口冻结解冻图层列表如何使用
本帖最后由 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)
)
)
)
页:
[1]