净间距阵列修复

wutian7777jsj

把第126行改下，考虑单行情况
(command "_.array" ss "" "_R" (atoi rows) (atoi cols) (if(= 1 (atoi rows)) col_dist row_dist) col_dist)
CAD的array命令对于单行单列运行数据输入流是有差异的

小毛草

2. ;;; 带记忆功能的矩形净间距阵列LISP
   
3. (defun c:AW (/ dcl_content dcl_file dcl_id rows cols row_net col_net ss result bbox obj_width obj_height row_dist col_dist)
   
4.     (vl-load-com)
   
5.    
   
6.     ;; 从注册表读取记忆值
   
7.     (setq rows (get_reg "RectArrayNet" "Rows" "4"))
   
8.     (setq cols (get_reg "RectArrayNet" "Cols" "4"))
   
9.     (setq row_net (get_reg "RectArrayNet" "RowNet" "50"))
   
10.     (setq col_net (get_reg "RectArrayNet" "ColNet" "50"))
    
11.    
    
12.     ;;; 定义DCL文件内容
    
13.     (setq dcl_content (strcat
    
14.         "rect_array_net : dialog {\n"
    
15.         "    label = "矩形净间距阵列";\n"
    
16.         "    spacer;\n"
    
17.         "    : text { label = "阵列参数:"; }\n"
    
18.         "    : row {\n"
    
19.         "        : column {\n"
    
20.         "            : edit_box {\n"
    
21.         "                key = "rows";\n"
    
22.         "                label = "Y行数:";\n"
    
23.         "                value = "" rows "";\n"
    
24.         "                edit_width = 8;\n"
    
25.         "            }\n"
    
26.         "            : edit_box {\n"
    
27.         "                key = "cols";\n"
    
28.         "                label = "X列数:";\n"
    
29.         "                value = "" cols "";\n"
    
30.         "                edit_width = 8;\n"
    
31.         "            }\n"
    
32.         "        }\n"
    
33.         "        : column {\n"
    
34.         "            : edit_box {\n"
    
35.         "                key = "row_net";\n"
    
36.                 "                label = "Y行间距:";\n"
    
37.         "                value = "" row_net "";\n"
    
38.         "                edit_width = 8;\n"
    
39.         "            }\n"
    
40.         "            : edit_box {\n"
    
41.         "                key = "col_net";\n"
    
42.         "                label = "X列间距:";\n"
    
43.         "                value = "" col_net "";\n"
    
44.         "                edit_width = 8;\n"
    
45.         "            }\n"
    
46.         "        }\n"
    
47.         "    }\n"
    
48.         "    spacer;\n"
    
49.         "    : text { label = "说明: 净间距 = 对象之间的净空距离"; }\n"
    
50.         "    : text { label = "阵列间距 = 对象尺寸 + 净间距"; }\n"
    
51.         "    spacer;\n"
    
52.         "    : row {\n"
    
53.         "        : button {\n"
    
54.         "            key = "accept";\n"
    
55.         "            label = "确定";\n"
    
56.         "            is_default = true;\n"
    
57.         "        }\n"
    
58.         "        : button {\n"
    
59.         "            key = "cancel";\n"
    
60.         "            label = "取消";\n"
    
61.         "            is_cancel = true;\n"
    
62.         "        }\n"
    
63.     "    }\n"
    
64.     "}\n"
    
65.     ))
    
66.    
    
67.     ;; 创建临时DCL文件
    
68.     (setq dcl_file (vl-filename-mktemp "rect_array_net.dcl"))
    
69.     (setq f (open dcl_file "w"))
    
70.     (write-line dcl_content f)
    
71.     (close f)
    
72.    
    
73.     ;; 加载DCL文件
    
74.     (setq dcl_id (load_dialog dcl_file))
    
75.    
    
76.     (if (not (new_dialog "rect_array_net" dcl_id))
    
77.         (progn
    
78.             (alert "无法加载对话框!")
    
79.             (unload_dialog dcl_id)
    
80.             (vl-file-delete dcl_file)
    
81.             (exit)
    
82.         )
    
83.     )
    
84.    
    
85.     ;; 动作处理
    
86.     (action_tile "accept"
    
87.         "(progn
    
88.             (setq rows (get_tile "rows"))
    
89.             (setq cols (get_tile "cols"))
    
90.             (setq row_net (get_tile "row_net"))
    
91.             (setq col_net (get_tile "col_net"))
    
92.             (done_dialog 1)
    
93.         )"
    
94.     )
    
95.    
    
96.     (action_tile "cancel" "(done_dialog 0)")
    
97.    
    
98.     ;; 显示对话框并处理结果
    
99.     (setq result (start_dialog))
    
100.     (unload_dialog dcl_id)
     
101.     (vl-file-delete dcl_file)
     
102.    
     
103.     (if (= result 1)
     
104.         (progn
     
105.             ;; 保存到注册表
     
106.             (put_reg "RectArrayNet" "Rows" rows)
     
107.             (put_reg "RectArrayNet" "Cols" cols)
     
108.             (put_reg "RectArrayNet" "RowNet" row_net)
     
109.             (put_reg "RectArrayNet" "ColNet" col_net)
     
110.             
     
111.             ;; 选择对象
     
112.             (if (setq ss (ssget))
     
113.                 (progn
     
114.                     ;; 获取选择集边界框
     
115.                     (setq bbox (get_ss_bbox ss))
     
116.                     (if bbox
     
117.                         (progn
     
118.                             ;; 计算对象尺寸
     
119.                             (setq obj_width (- (caadr bbox) (caar bbox)))
     
120.                             (setq obj_height (- (cadadr bbox) (cadar bbox)))
     
121.                            
     
122.                             ;; 计算阵列间距（对象尺寸 + 净间距）
     
123.                             (setq row_dist (+ obj_height (atof row_net)))
     
124.                             (setq col_dist (+ obj_width (atof col_net)))
     
125.                            
     
126.                             ;; 执行阵列 - 修复关键问题
     
127.                             (command "_.-array" ss "" "_R"
     
128.                                      (atoi rows) (atoi cols)
     
129.                                      row_dist col_dist)
     
130.                             (princ (strcat "\n创建了 " rows " 行 " cols " 列的矩形净间距阵列"))
     
131.                             (princ (strcat "\n对象尺寸: " (rtos obj_width 2 2) " x " (rtos obj_height 2 2)))
     
132.                             (princ (strcat "\n阵列间距: " (rtos col_dist 2 2) " x " (rtos row_dist 2 2)))
     
133.                         )
     
134.                         (princ "\n无法计算对象尺寸")
     
135.                     )
     
136.                 )
     
137.                 (princ "\n未选择对象")
     
138.             )
     
139.         )
     
140.     )
     
141.     (princ)
     
142. )
     
143. 
     
144. ;;; 获取选择集边界框 - 修复版本
     
145. (defun get_ss_bbox (ss / i ent minpt maxpt minx miny maxx maxy obj)
     
146.     (if (and ss (> (sslength ss) 0))
     
147.         (progn
     
148.             (setq i 0)
     
149.             (repeat (sslength ss)
     
150.                 (setq ent (ssname ss i))
     
151.                 (setq obj (vlax-ename->vla-object ent))
     
152.                 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpt 'maxpt))))
     
153.                     (progn
     
154.                         (setq minpt (vlax-safearray->list minpt))
     
155.                         (setq maxpt (vlax-safearray->list maxpt))
     
156.                         
     
157.                         (if (= i 0)
     
158.                             (progn
     
159.                                 (setq minx (car minpt)
     
160.                                       miny (cadr minpt)
     
161.                                       maxx (car maxpt)
     
162.                                       maxy (cadr maxpt))
     
163.                             )
     
164.                             (progn
     
165.                                 (setq minx (min minx (car minpt))
     
166.                                       miny (min miny (cadr minpt))
     
167.                                       maxx (max maxx (car maxpt))
     
168.                                       maxy (max maxy (cadr maxpt)))
     
169.                             )
     
170.                         )
     
171.                     )
     
172.                 )
     
173.                 (setq i (1+ i))
     
174.             )
     
175.             (if (and minx maxx) ; 确保有有效的边界框
     
176.                 (list (list minx miny) (list maxx maxy))
     
177.             )
     
178.         )
     
179.     )
     
180. )
     
181. 
     
182. ;;; 注册表读写函数
     
183. (defun get_reg (app key default / value)
     
184.     (setq value (vl-registry-read (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\" app) key))
     
185.     (if value value default)
     
186. )
     
187. 
     
188. (defun put_reg (app key value)
     
189.     (vl-registry-write (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\" app) key value)
     
190. )

;;; 带记忆功能的矩形净间距阵列LISP<br /> (defun c:AW (/ dcl_content dcl_file dcl_id rows cols row_net col_net ss result bbox obj_width obj_height row_dist col_dist)<br />     (vl-load-com)<br />     <br />     ;; 从注册表读取记忆值<br />     (setq rows (get_reg "RectArrayNet" "Rows" "4"))<br />     (setq cols (get_reg "RectArrayNet" "Cols" "4"))<br />     (setq row_net (get_reg "RectArrayNet" "RowNet" "50"))<br />     (setq col_net (get_reg "RectArrayNet" "ColNet" "50"))<br />     <br />     ;;; 定义DCL文件内容<br />     (setq dcl_content (strcat<br />         "rect_array_net : dialog {\n"<br />         "    label = "矩形净间距阵列";\n"<br />         "    spacer;\n"<br />         "    : text { label = "阵列参数:"; }\n"<br />         "    : row {\n"<br />         "        : column {\n"<br />         "            : edit_box {\n"<br />         "                key = "rows";\n"<br />         "                label = "Y行数:";\n"<br />         "                value = "" rows "";\n"<br />         "                edit_width = 8;\n"<br />         "            }\n"<br />         "            : edit_box {\n"<br />         "                key = "cols";\n"<br />         "                label = "X列数:";\n"<br />         "                value = "" cols "";\n"<br />         "                edit_width = 8;\n"<br />         "            }\n"<br />         "        }\n"<br />         "        : column {\n"<br />         "            : edit_box {\n"<br />         "                key = "row_net";\n"<br />                 "                label = "Y行间距:";\n"<br />         "                value = "" row_net "";\n"<br />         "                edit_width = 8;\n"<br />         "            }\n"<br />         "            : edit_box {\n"<br />         "                key = "col_net";\n"<br />         "                label = "X列间距:";\n"<br />         "                value = "" col_net "";\n"<br />         "                edit_width = 8;\n"<br />         "            }\n"<br />         "        }\n"<br />         "    }\n"<br />         "    spacer;\n"<br />         "    : text { label = "说明: 净间距 = 对象之间的净空距离"; }\n"<br />         "    : text { label = "阵列间距 = 对象尺寸 + 净间距"; }\n"<br />         "    spacer;\n"<br />         "    : row {\n"<br />         "        : button {\n"<br />         "            key = "accept";\n"<br />         "            label = "确定";\n"<br />         "            is_default = true;\n"<br />         "        }\n"<br />         "        : button {\n"<br />         "            key = "cancel";\n"<br />         "            label = "取消";\n"<br />         "            is_cancel = true;\n"<br />         "        }\n"<br />     "    }\n"<br />     "}\n"<br />     ))<br />     <br />     ;; 创建临时DCL文件<br />     (setq dcl_file (vl-filename-mktemp "rect_array_net.dcl"))<br />     (setq f (open dcl_file "w"))<br />     (write-line dcl_content f)<br />     (close f)<br />     <br />     ;; 加载DCL文件<br />     (setq dcl_id (load_dialog dcl_file))<br />     <br />     (if (not (new_dialog "rect_array_net" dcl_id))<br />         (progn<br />             (alert "无法加载对话框!")<br />             (unload_dialog dcl_id)<br />             (vl-file-delete dcl_file)<br />             (exit)<br />         )<br />     )<br />     <br />     ;; 动作处理<br />     (action_tile "accept" <br />         "(progn<br />             (setq rows (get_tile "rows"))<br />             (setq cols (get_tile "cols"))<br />             (setq row_net (get_tile "row_net"))<br />             (setq col_net (get_tile "col_net"))<br />             (done_dialog 1)<br />         )"<br />     )<br />     <br />     (action_tile "cancel" "(done_dialog 0)")<br />     <br />     ;; 显示对话框并处理结果<br />     (setq result (start_dialog))<br />     (unload_dialog dcl_id)<br />     (vl-file-delete dcl_file)<br />     <br />     (if (= result 1)<br />         (progn<br />             ;; 保存到注册表<br />             (put_reg "RectArrayNet" "Rows" rows)<br />             (put_reg "RectArrayNet" "Cols" cols)<br />             (put_reg "RectArrayNet" "RowNet" row_net)<br />             (put_reg "RectArrayNet" "ColNet" col_net)<br />             <br />             ;; 选择对象<br />             (if (setq ss (ssget))<br />                 (progn<br />                     ;; 获取选择集边界框<br />                     (setq bbox (get_ss_bbox ss))<br />                     (if bbox<br />                         (progn<br />                             ;; 计算对象尺寸<br />                             (setq obj_width (- (caadr bbox) (caar bbox)))<br />                             (setq obj_height (- (cadadr bbox) (cadar bbox)))<br />                             <br />                             ;; 计算阵列间距（对象尺寸 + 净间距）<br />                             (setq row_dist (+ obj_height (atof row_net)))<br />                             (setq col_dist (+ obj_width (atof col_net)))<br />                             <br />                             ;; 执行阵列 - 修复关键问题<br />                             (command "_.-array" ss "" "_R" <br />                                      (atoi rows) (atoi cols) <br />                                      row_dist col_dist)<br />                             (princ (strcat "\n创建了 " rows " 行 " cols " 列的矩形净间距阵列"))<br />                             (princ (strcat "\n对象尺寸: " (rtos obj_width 2 2) " x " (rtos obj_height 2 2)))<br />                             (princ (strcat "\n阵列间距: " (rtos col_dist 2 2) " x " (rtos row_dist 2 2)))<br />                         )<br />                         (princ "\n无法计算对象尺寸")<br />                     )<br />                 )<br />                 (princ "\n未选择对象")<br />             )<br />         )<br />     )<br />     (princ)<br /> )<br /> <br /> ;;; 获取选择集边界框 - 修复版本<br /> (defun get_ss_bbox (ss / i ent minpt maxpt minx miny maxx maxy obj)<br />     (if (and ss (> (sslength ss) 0))<br />         (progn<br />             (setq i 0)<br />             (repeat (sslength ss)<br />                 (setq ent (ssname ss i))<br />                 (setq obj (vlax-ename->vla-object ent))<br />                 (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpt 'maxpt))))<br />                     (progn<br />                         (setq minpt (vlax-safearray->list minpt))<br />                         (setq maxpt (vlax-safearray->list maxpt))<br />                         <br />                         (if (= i 0)<br />                             (progn<br />                                 (setq minx (car minpt)<br />                                       miny (cadr minpt)<br />                                       maxx (car maxpt)<br />                                       maxy (cadr maxpt))<br />                             )<br />                             (progn<br />                                 (setq minx (min minx (car minpt))<br />                                       miny (min miny (cadr minpt))<br />                                       maxx (max maxx (car maxpt))<br />                                       maxy (max maxy (cadr maxpt)))<br />                             )<br />                         )<br />                     )<br />                 )<br />                 (setq i (1+ i))<br />             )<br />             (if (and minx maxx) ; 确保有有效的边界框<br />                 (list (list minx miny) (list maxx maxy))<br />             )<br />         )<br />     )<br /> )<br /> <br /> ;;; 注册表读写函数<br /> (defun get_reg (app key default / value)<br />     (setq value (vl-registry-read (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\" app) key))<br />     (if value value default)<br /> )<br /> <br /> (defun put_reg (app key value)<br />     (vl-registry-write (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\" app) key value)<br /> )

zmzk

又是缺少函数: 错误: no function definition: GET_REG

阿猪蛋

又是缺少函数: 错误: no function definition: GET_REG