将视口从定义点移动到指定图层的脚本。

;;  05.03.07
;;  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
;;  force vp's to layer  "Viewport Borders"
;;  ignore vp's on layer "vpPlot"      
;;  +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
(defun c:vp2LayAll () (vp2lay ""))
(defun vp2lay (tabname / lay obj targetobj rtnflag)
  (vl-load-com)
  
;;  CAB version to make a layer
;;  returns nil if make failed
(defun MakeLayer (lyrname acDoc / lyrobj) 
  (vl-load-com) 
  (if 
    (not 
      (vl-catch-all-error-p 
        (setq lyrobj (vl-catch-all-apply 'vla-add (list (vla-get-layers acDoc) lyrname)))) 
    ) 
    lyrobj 
  ) 
) 
  
  (if (null color) ; use default (defined in Globle variable) colors
    (setq color (if lockflag *vpColorLk *vpColorUnLk))
  )
  ;;  A spicific tab name can be used to work in one Layout only
  (or (= (type tabname) 'STR) (setq tabname "")) ; default to ALL
  (if (= tabname "Model")
    (progn (alert "Not allowed in Model Space") (quit))
  )
  
  ;; make Layer "Viewport Borders" color=12  NoPlot
  ;;  try to rename first!
  (setq vpLayer "Viewport Borders")
  (if (and (not (tblsearch "layer" vpLayer))
        (setq lyrobj (MakeLayer vpLayer (vla-get-activedocument (vlax-get-acad-object))
       )))
    (progn
      (vla-put-color lyrobj 12)
      (vla-put-plottable lyrobj :vlax-false)
      (vlax-release-object lyrobj)
    )
   )
  ;;  step through each Layout and step through each object in the layout
  ;;  if object is a VP and the layer is NOT VPPLOT change the layer to "Viewport Borders"
  ;;  if the VP has a non rectangle shape change the pline outline layer associated with the VP
  (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) ; for each layout
    (if (and (or (= tabname "")
                 (= (vla-get-name lay) tabname))
             (eq :vlax-false (vla-get-modeltype lay)))
      (vlax-for obj (vla-get-block lay) ; for each obj in layout
        (if (and (= (vla-get-objectname obj) "AcDbViewport")
                 (or (null targetobj) (equal obj targetobj))
            )
         (if (/= (strcase (vla-get-layer obj)) "VPPLOT")
          (progn
            (vla-put-layer obj vpLayer)
            (if (setq ent (assoc 340 (entget (vlax-vla-object->ename obj))))
              (vla-put-layer (vlax-ename->vla-object (cdr ent)) vpLayer)
            )
            (setq rtnflag t)
          ))
        )
      )
    )
  )
  rtnflag
)