在多个LAYOUTS中修改多个视口（VIEWPORTS）的图层设置

Lisphk

[Actionscript3] 纯文本查看 复制代码

(defun c:tt (/ ad co e el o s vc)
  ;; RJP » 2019-01-23
  ;; Matches viewport properties to all layouts if target has a similar center location
  (setvar 'tilemode 0)
  (cond	((and (setq e (car (entsel "\nPick source viewport with correct layers: ")))
	      ;; Is it a viewport?
	      (= "VIEWPORT" (cdr (assoc 0 (setq el (entget e '("ACAD"))))))
	      ;; Check if there are layer overrides in the selected viewport
	      (vl-remove-if '(lambda (x) (/= (car x) 331)) el)
	      ;; Get the center of the vieport selected
	      (setq vc (cdr (assoc 10 el)))
	      ;; Select all paperspace viewports in drawing and remove the source
	      (ssdel e (setq s (ssget "_X" '((0 . "VIEWPORT") (-4 . "!=") (69 . 1)))))
	      (setq s (mapcar 'cadr (ssnamex s)))
	 )
	 (setvar 'cmdecho 0)
	 (setq ad (vla-get-activedocument (vlax-get-acad-object)))
	 (setq o (vlax-ename->vla-object e))
	 (foreach x s
	   ;; If the center point is within a fuzz value of 1
	   (cond ((equal vc (cdr (assoc 10 (setq el (entget x)))) 1)
		  ;; Copy the source viewport
		  (setq	co (car	(vlax-invoke
				  ad
				  'copyobjects
				  (list o)
				  (vlax-ename->vla-object (cdr (assoc 330 (entget x))))
				  t
				)
			   )
		  )
		  ;; Matchpprop won't match from tab to tab but will from drawing to drawing .. go figure.
		  (setvar 'ctab (cdr (assoc 410 el)))
		  ;; Make sure we're in paperspace
		  (command "_.pspace")
		  ;; Ugly but seems to work
		  (command "_.matchprop" (vlax-vla-object->ename co) x "")
		  ;; Delete the copied viewport
		  (vla-delete co)
		  ;; Print the tab name
		  (print (cdr (assoc 410 el)))
		 )
	   )
	 )
	 (setvar 'cmdecho 1)
	)
  )
  (princ)
)

tzfcn

好代码！真是值得好好学习一下。

sicky111

学习一下。