Lisp for viewport works, but not 100% correct. After loading again, problem solved.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello everyone,
I have been using the lisp below for many years. This lisp creates 2 commands that allow me to lock and unlock the displays of the viewports. He also puts them in the "viewports" layer and sets them to "do not plot". But in addition to these tasks, it also gives them a color. The locked displays/viewports turn green and the unlocked ones turn red.
This so that I can clearly see which viewports are locked and do not accidentally work/zoom in and out in an unlocked viewport so that the scale and the view are no longer correct.
When I start AutoCAD or a new drawing, the lisp still works, but when I execute the command "VPL" (viewport lock) the viewport window no longer turns green but white. But with "VPU" (viewport unlock) the viewport does turn red.
If I then reload the lisp, it works as it should.
So if I then draw a viewport, it will first be placed in the current layer with the color of that layer and if I then use VPU or VPL, it will be in the viewports layer, will not be printed and will have a red or green color.
But why do I have to reload it every time I restart AutoCAD?
The lisp is simply in Startup Suite
(vl-load-com)
(defun dxf (n ed) (cdr (assoc n ed)))
(defun c:vpl (/ AD COUNT ENT I PL SS TABNAME VP VPNO)
(setq ad (vla-get-activedocument (vlax-get-acad-object)))
(COMMAND "-LAYER" "N" "Viewport" "" "")
(COMMAND "-LAYER" "U" "Viewport" "" "")
(COMMAND "-LAYER" "PLOT" "N" "Viewport" "")
(COMMAND "-LAYER" "ON" "Viewport" "")
(vlax-for lay (vla-get-layouts ad)
(if (/= (setq TabName (strcase (vla-get-name lay))) "MODEL") ;_ end of /=
(progn
(if (setq ss (ssget
"X"
(list (cons 0 "viewport")
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
(progn
(setq count (sslength ss))
(setq i 0)
(if (> count 0)
(progn
(while (< i count)
(setq
ent (ssname ss
i
) ;_ end of ssname
) ;_ end of setq
(setq vpNo
(dxf
69
(entget
ent
) ;_ end of entget
) ;_ end of dxf
) ;_ end of setq
(if (> vpNo 1)
(progn
(setq vp (vlax-ename->vla-object
ent
) ;_ end of vlax-ename->vla-object
) ;_ end of setq
(if (= (vla-get-clipped
vp
) ;_ end of vla-get-clipped
:vlax-false
) ;_ end of =
(progn
(vla-put-color
vp
3
) ;_ end of vla-put-color
(vla-put-layer
vp
"Viewport"
) ;_ end of vla-put-layer
) ;_ end of progn
(progn
(setq
pl (entget
(dxf
340
(entget
ent
) ;_ end of entget
) ;_ end of dxf
) ;_ end of entget
) ;_ end of setq
;get clip entity
(setq pl (vlax-ename->vla-object
(dxf -1
pl
) ;_ end of dxf
) ;_ end of vlax-ename->vla-object
) ;_ end of setq
(vla-put-color
pl
3
) ;_ end of vla-put-color
(vla-put-layer
pl
"Viewport"
) ;_ end of vla-put-layer
(vla-put-color
vp
3
) ;_ end of vla-put-color
(vla-put-layer
vp
"Viewport"
) ;_ end of vla-put-layer
) ;_ end of progn
) ;_ end of if
(vla-put-displaylocked
vp
:vlax-true
) ;_ end of vla-put-displaylocked
(vla-update vp)
) ;_ end of progn
) ;_ end of if
(setq i (1+ i))
) ;_ end of while
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun c:vpu (/ AD COUNT ENT I PL SS TABNAME VP VPNO)
(setq ad (vla-get-activedocument (vlax-get-acad-object)))
(COMMAND "-LAYER" "N" "Viewport" "" "")
(COMMAND "-LAYER" "U" "Viewport" "" "")
(COMMAND "-LAYER" "PLOT" "N" "Viewport" "")
(COMMAND "-LAYER" "ON" "Viewport" "")
(vlax-for lay (vla-get-layouts ad)
(if (/= (setq TabName (strcase (vla-get-name lay))) "MODEL") ;_ end of /=
(progn
(if (setq ss (ssget
"X"
(list (cons 0 "viewport")
) ;_ end of list
) ;_ end of ssget
) ;_ end of setq
(progn
(setq count (sslength ss))
(setq i 0)
(if (> count 0)
(progn
(while (< i count)
(setq
ent (ssname ss
i
) ;_ end of ssname
) ;_ end of setq
(setq vpNo
(dxf
69
(entget
ent
) ;_ end of entget
) ;_ end of dxf
) ;_ end of setq
(if (> vpNo 1)
(progn
(setq vp (vlax-ename->vla-object
ent
) ;_ end of vlax-ename->vla-object
) ;_ end of setq
(if (= (vla-get-clipped
vp
) ;_ end of vla-get-clipped
:vlax-false
) ;_ end of =
(progn
(vla-put-color
vp
1
) ;_ end of vla-put-color
; 3 green
(vla-put-layer
vp
"Viewport"
) ;_ end of vla-put-layer
) ;_ end of progn
(progn
(setq
pl (entget
(dxf
340
(entget
ent
) ;_ end of entget
) ;_ end of dxf
) ;_ end of entget
) ;_ end of setq
;get clip entity
(setq pl (vlax-ename->vla-object
(dxf -1
pl
) ;_ end of dxf
) ;_ end of vlax-ename->vla-object
) ;_ end of setq
(vla-put-color
pl
1
) ;_ end of vla-put-color
(vla-put-layer
pl
"Viewport"
) ;_ end of vla-put-layer
(vla-put-color
vp
1
) ;_ end of vla-put-color
; 3 green
(vla-put-layer
vp
"Viewport"
) ;_ end of vla-put-layer
) ;_ end of progn
) ;_ end of if
(vla-put-displaylocked
vp
:vlax-false
) ;_ end of vla-put-displaylocked
(vla-update vp)
) ;_ end of progn
) ;_ end of if
(setq i (1+ i))
) ;_ end of while
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
