编制一个关于视口的插件，但是一直报错.....
本帖最后由 大源 于 2025-3-24 15:46 编辑目的：
1、在模型空间内：所选范围内某个图层的矩形外框，
2、在布局空间内根据选择的外框开视口
2、在开视口时，可以选择预设视口大小（A0,A1,A2,A3,A4），并根据选择视口大小自动放大或缩小视口比例
3、在布局空间内视口可以选择摆放顺序
程序本体：
(defun c:PLSK ( / *error* ss lay rectData paperSizes paperSize vpSize scaleFactor pt arrange vpObj clayer_old)
(vl-load-com)
(setvar 'cmdecho 0)
;; 错误处理函数
(defun *error* (msg)
(princ (strcat "\n错误: " msg))
(setvar 'clayer clayer_old)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ)
)
;; 图纸尺寸库（单位：毫米）
(setq paperSizes
'(
("A0" 841.0 1189.0)
("A1" 594.0 841.0)
("A2" 420.0 594.0)
("A3" 297.0 420.0)
("A4" 210.0 297.0)
)
)
;; 步骤1：在模型空间选择矩形
(setq clayer_old (getvar 'clayer))
(initget 1)
(setq lay (getstring "\n请输入目标图层名称: "))
(princ "\n选择矩形外框: ")
(setq ss (ssget (list (cons 0 "LWPOLYLINE") (cons 8 lay) (cons 90 4))))
(if (null ss)
(progn
(princ "\n未找到符合条件的矩形！")
(exit)
)
)
;; 获取矩形尺寸（修正坐标提取方式）
(setq rectData (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates (vlax-ename->vla-object (ssname ss 0))))))
(setq xCoords (mapcar 'car (mapcar 'list rectData (nthcdr 1 rectData)))
yCoords (mapcar 'cadr (mapcar 'list rectData (nthcdr 1 rectData))))
(setq rectWidth(abs (- (apply 'max xCoords) (apply 'min xCoords)))
rectHeight (abs (- (apply 'max yCoords) (apply 'min yCoords))))
;; 步骤2：切换到布局空间
(command "_tilemode" "0")
;; 步骤3：选择图纸尺寸
(initget "A0 A1 A2 A3 A4")
(setq paperSize (getkword "\n选择图纸尺寸 : "))
(setq vpSize (cdr (assoc paperSize paperSizes)))
;; 计算比例因子（添加单位转换）
(setq scaleFactor
(min
(/ (car vpSize) (* rectWidth 1000.0)); 假设模型空间单位为米
(/ (cadr vpSize) (* rectHeight 1000.0))
)
)
;; 步骤4：选择排列方向
(initget "Horizontal Vertical")
(setq arrange (getkword "\n选择排列方式 : "))
;; 步骤5：创建视口（修正命令调用）
(setq pt (getpoint "\n指定视口插入点: "))
(command "-vports"
"_non" pt
"_non"
(polar pt
(if (eq arrange "Horizontal") 0 (/ pi 2))
(* (if (eq arrange "Horizontal") (car vpSize) (cadr vpSize)) 0.001)); 转换为米
"")
;; 调整视口比例（添加错误保护）
(if (setq vpObj (vlax-ename->vla-object (entlast)))
(progn
(vla-put-standardscale vpObj acVpCustomScale)
(vla-put-customscale vpObj scaleFactor)
)
)
(princ (strcat "\n创建完成，比例设置为 1:" (rtos (/ 1 scaleFactor) 2 2)))
(setvar 'clayer clayer_old)
(princ)
)
你报错提示你的是什么
现在你贴的函数，缺少 nthcdr 函数
页:
[1]