VPLocker修改
我使用lisp VPLocker锁定和解锁布局上的视口，效果很好，但当我使用多段线剪裁现有视口（例如）时，我在剪裁的视口上运行VPLocker例程，视口（此时它已从视图中消失）会按预期更改颜色，但是我用来剪裁视口的多段线（它是唯一剩下的可见项）并没有改变颜色。是否可以更改或添加到例程中，使其成为可能，这样无论您使用什么来剪裁视口，VPLocker都会锁定并更改用于剪裁视口的项目的颜色？。
vplocker。lsp 为了好玩：
(vl-load-com)
;;;--------------------------------------------------------------------;
;;; Viewport lock
(defun c:VPL () (c:ViewportLock))
(defun c:ViewportLock (/ option ss)
(princ "\rVIEWPORTLOCK ")
(_PutPViewportLockAndColor :vlax-true 4)
)
;;;--------------------------------------------------------------------;
;;; Viewport unlock
(defun c:VPU () (c:ViewportUnlock))
(defun c:ViewportUnlock (/ option ss)
(princ "\rVIEWPORTUNLOCK ")
(_PutPViewportLockAndColor :vlax-false 256)
)
;;;--------------------------------------------------------------------;
;;; Put PViewport Lock and Color
(defun _PutPViewportLockAndColor (lock color / *error* option ss acDoc)
(defun *error* (msg)
(if (and ss (= 'VLA-OBJECT (type ss)))
(vla-delete ss)
)
(if acDoc
(vla-endundomark acDoc)
)
(cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\n** " msg " ** ")))
) ; Fatal error, display it
(princ)
)
(if (and (not (initget "All Current"))
(or (setq option
(getkword
"\nEnter layout(s) to modify <Current>: "
)
)
(setq option "Current")
)
(setq ss
(cond ((= "Current" option) (_GetPViewports nil))
((_GetPViewports T))
)
)
)
(progn
(vla-startundomark
(setq acDoc
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(vlax-for x (setq ss (vla-get-activeselectionset acDoc))
(vla-put-color x color)
(if (vlax-property-available-p x 'displaylocked)
(vla-put-displaylocked x lock)
)
)
(if (= (vla-get-mspace acDoc) :vlax-true)
(vla-regen acDoc acactiveviewport)
)
(setq ss (vla-delete ss))
(*error* nil)
)
(if option
(*error* "Command not allowed in Model Tab")
)
)
(princ)
)
;;;--------------------------------------------------------------------;
;;; Get PViewports
(defun _GetPViewports (allTabs)
(ssget
"_x"
(list
'(-4 . "<OR")
'(0 . "VIEWPORT")
'(-4 . "<AND")
'(0 . "LWPOLYLINE")
'(102 . "{ACAD_REACTORS")
'(-4 . "AND>")
'(-4 . "OR>")
(cons
410
(cond
(allTabs
(vl-string-right-trim
","
(apply 'strcat
(mapcar '(lambda (x) (strcat x ",")) (layoutlist))
)
)
)
((getvar 'ctab))
)
)
)
)
)
此处修订代码。。。总结：
添加了一个*错误*处理程序和撤消支持。现在，您可以按Ctrl+Z组合键而不会出现问题（是的，即使对于多个布局也是如此）。 此处修订代码。。。总结：
添加了对激活的PViewport的检查。。。如果处于活动状态，则会重新生成acActiveViewport。 太棒了这很好用D： D
... 很乐意帮忙
页:
[1]