CAD批量创建视口布局插件v2.0

;批量视口2.0;命令：CTSK;作者：创特空间;网站：www.chuangtekongjian.cn;插件用于批量生成视口;1.仅能识别矩形视口框。;2.当不给定方向线时，视口生成顺序为选择图框顺序，可以整体框选所有图框，顺序默认为从右到左。;3.给定方向线，视口根据方向依次排列。;4.视口显示比例可自定义。;5.可选择视口生成起点，根据命令行提示操作。;6.可以选择生成视口是否锁定，根据命令行提示操作。(vl-load-com)(defun c:CTSK()	(princ "\n选取视口框...")(setq ss (ssget))(setq refEnt (car (entsel "\n请选择方向参考线(多段线)，如不选请直接右键/回车: ")))(if refEnt (setq refVla (vlax-ename->vla-object refEnt)) (setq refVla nil))(setq i 0)	(setq n 0)	(setq dx 10.0)(initget 4)(setq dxIn (getdist (strcat "\n视口间隔(纸空间单位) <" (rtos dx 2 2) ">: ")))(if dxIn (setq dx dxIn))(setq sc 1.0)(initget 6)(setq scIn (getreal (strcat "\n视口比例(1:n)，请输入n <" (rtos sc 2 2) ">: ")))(if scIn (setq sc scIn))(command "TILEMODE" "0")(setq q (getvar "OSMODE"))(setvar "OSMODE" 0)	(setq vp1 (getpoint "请选择视口插入点："))(setq vpx1 (nth 0 vp1))(setq vpy1 (nth 1 vp1))	(initget 1 "Y N") (setq skl (getkword "\n视口是否锁定[锁定(Y)/不锁定(N)]："))(setq ssList nil)(while (< i (sslength ss))    (setq ssn (ssname ss i))    (setq ssdata (entget ssn))    (if (and (= (cdr (assoc 0 ssdata)) "LWPOLYLINE") (= (cdr (assoc 90 ssdata)) 4))        (progn            (setq sortParam 0.0)            (if refVla                (progn                    (setq boxVla (vlax-ename->vla-object ssn))                    (setq intPts (vlax-invoke refVla 'IntersectWith boxVla 0))                    (if (and intPts (>= (length intPts) 3))                        (setq sortParam (vlax-curve-getParamAtPoint refVla (vlax-curve-getClosestPointTo refVla (list (car intPts) (cadr intPts) (caddr intPts)))))                    )                )            )            (setq ssList (append ssList (list (list ssn sortParam))))        )    )    (setq i (+ i 1)))(if refVla    (setq ssList (vl-sort ssList '(lambda (a b) (< (cadr a) (cadr b))))))(setq i 0)(while (< i (length ssList))	(setq ssn (car (nth i ssList)))	(setq ssdata (entget ssn))	(progn		  	(setq Lst (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) ssdata)))		(setq p1 (nth 0 Lst))		(setq p2 (nth 1 Lst))		(setq p3 (nth 2 Lst))		(setq p4 (nth 3 Lst))		(setq uc1_ok nil)		(if refVla		    (progn		        (setq boxVla (vlax-ename->vla-object ssn))		        (setq intPts (vlax-invoke refVla 'IntersectWith boxVla 0))		        (if (and intPts (>= (length intPts) 6))		            (progn		                (setq ptsList nil idx 0)		                (while (< idx (length intPts))		                    (setq ptsList (append ptsList (list (list (nth idx intPts) (nth (+ idx 1) intPts) (nth (+ idx 2) intPts)))))		                    (setq idx (+ idx 3))		                )		                (setq ptsList (vl-sort ptsList '(lambda (a b) (< (vlax-curve-getParamAtPoint refVla (vlax-curve-getClosestPointTo refVla a)) (vlax-curve-getParamAtPoint refVla (vlax-curve-getClosestPointTo refVla b))))))		                (setq PtIn (car ptsList) PtOut (last ptsList))		                (setq vecD (list (- (car PtOut) (car PtIn)) (- (cadr PtOut) (cadr PtIn))))		                (setq lenD (distance '(0 0) vecD))		                (if (> lenD 1e-6)		                    (progn		                        (setq U (list (/ (car vecD) lenD) (/ (cadr vecD) lenD)))		                        (setq V (list (cadr U) (- (car U))))		                        (setq ptVals (mapcar '(lambda (p)		                                                (list p		                                                      (+ (* (car p) (car U)) (* (cadr p) (cadr U)))		                                                      (+ (* (car p) (car V)) (* (cadr p) (cadr V)))		                                                )		                                              )		                                             (list p1 p2 p3 p4)))		                        (setq ptsSortU (vl-sort ptVals '(lambda (a b) (< (cadr a) (cadr b)))))		                        (setq backPts (list (nth 0 ptsSortU) (nth 1 ptsSortU)))		                        (setq fwdPts  (list (nth 2 ptsSortU) (nth 3 ptsSortU)))		                        (if (> (caddr (nth 0 backPts)) (caddr (nth 1 backPts)))		                            (setq BR (car (nth 0 backPts)) BL (car (nth 1 backPts)))		                            (setq BR (car (nth 1 backPts)) BL (car (nth 0 backPts)))		                        )		                        (if (> (caddr (nth 0 fwdPts)) (caddr (nth 1 fwdPts)))		                            (setq FR (car (nth 0 fwdPts)) FL (car (nth 1 fwdPts)))		                            (setq FR (car (nth 1 fwdPts)) FL (car (nth 0 fwdPts)))		                        )		                        (setq uc1 BR uc2 FR uc3 BL)		                        (setq w_box (distance BR FR) h_box (distance BR BL))		                        (setq uc1_ok T)		                    )		                )		            )		        )		    )		)		(if (not uc1_ok)		    (progn		        (setq uc1 p4)		        (setq uc2 (list (- (nth 0 p3) (nth 0 p4)) (- (nth 1 p3) (nth 1 p4))))		        (setq uc3 (list (distance p1 p2) (distance p2 p3)))		        (setq w_box (distance p1 p2) h_box (distance p2 p3))		    )		)		(setq w_box_scaled (/ w_box sc))		(setq h_box_scaled (/ h_box sc))		(setq vpx2 (+ vpx1 w_box_scaled))		(setq vpy2 (+ vpy1 h_box_scaled))		(setq vp1 (list vpx1 vpy1))		(setq vp2 (list vpx2 vpy2))		(command "PSPACE")		(command "zoom" "w" vp1 vp2)		(command "-vports" vp1 vp2)		(command "MSPACE")		(command "UCS" "w")		(if uc1_ok		    (command "UCS" "_3" uc1 uc2 uc3)		    (command "UCS" uc1 uc2 uc3)		)		(command "plan" "c")			(command "zoom" "w" (list 0 0) (list w_box h_box))		(setq scaleVal (/ 1.0 sc))		(setq scaleStr (strcat (rtos scaleVal 2 8) "XP"))		(command "zoom" "s" scaleStr)		(if (= skl "Y")		  	(command "-vports" "L" "on" vp1 "si")		)		(setq n (+ n 1))			(setq vpx1 (+ vpx1 dx))			(setq vpx1 (+ vpx1 w_box_scaled))		)  	(setq i (+ i 1))  )(command "PSPACE")(command "zoom" "e")(setvar "OSMODE" q)(prin1)