净间距阵列修复
本帖最后由 hbxymx 于 2025-11-16 10:43 编辑我用AI写了一个净间距阵列的程序，主要应用于雕刻加工排版。发现X方向阵列间距会出错，同时2个方向阵列没有问题。帮忙修复一下，
经修改测试，单行或单列均正常，多行多列也正常
测试了，没毛病啊 rouka23 发表于 2025-11-16 10:14
测试了，没毛病啊
一般方形没有问题，带拐角的L形，T形的就会出现问题，我上传了测试图形，你测试一下就会发现问题。 本帖最后由 rouka23 于 2025-11-16 11:05 编辑
hbxymx 发表于 2025-11-16 10:46
一般方形没有问题，带拐角的L形，T形的就会出现问题，我上传了测试图形，你测试一下就会发现问题。
rouka23 发表于 2025-11-16 10:55
双向阵列是没有问题的，单方向x方向会出错， ;;; 带记忆功能的矩形净间距阵列LISP - 使用ActiveX方法
(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 pt1 pt2 f rows_val cols_val
row_net_val col_net_val base_pt)
(vl-load-com)
;; 从注册表读取记忆值
(setq rows (get_reg "RectArrayNet" "Rows" "4"))
(setq cols (get_reg "RectArrayNet" "Cols" "4"))
(setq row_net (get_reg "RectArrayNet" "RowNet" "50"))
(setq col_net (get_reg "RectArrayNet" "ColNet" "50"))
;;; 定义DCL文件内容
(setq dcl_content (strcat
"rect_array_net : dialog {\n"
" label = \"矩形净间距阵列\";\n"
" spacer;\n"
" : text { label = \"阵列参数:\"; }\n"
" : row {\n"
" : column {\n"
" : edit_box {\n"
" key = \"rows\";\n"
" label = \"Y行数:\";\n"
" value = \"" rows "\";\n"
" edit_width = 8;\n"
" }\n"
" : edit_box {\n"
" key = \"cols\";\n"
" label = \"X列数:\";\n"
" value = \"" cols "\";\n"
" edit_width = 8;\n"
" }\n"
" }\n"
" : column {\n"
" : edit_box {\n"
" key = \"row_net\";\n"
" label = \"Y行间距:\";\n"
" value = \"" row_net "\";\n"
" edit_width = 8;\n"
" }\n"
" : edit_box {\n"
" key = \"col_net\";\n"
" label = \"X列间距:\";\n"
" value = \"" col_net "\";\n"
" edit_width = 8;\n"
" }\n"
" }\n"
" }\n"
" spacer;\n"
" : text { label = \"说明: 净间距 = 对象之间的净空距离\"; }\n"
" : text { label = \"阵列间距 = 对象尺寸 + 净间距\"; }\n"
" spacer;\n"
" : row {\n"
" : button {\n"
" key = \"accept\";\n"
" label = \"确定\";\n"
" is_default = true;\n"
" }\n"
" : button {\n"
" key = \"cancel\";\n"
" label = \"取消\";\n"
" is_cancel = true;\n"
" }\n"
" }\n"
"}\n"
))
;; 创建临时DCL文件
(setq dcl_file (vl-filename-mktemp "rect_array_net.dcl"))
(setq f (open dcl_file "w"))
(write-line dcl_content f)
(close f)
;; 加载DCL文件
(setq dcl_id (load_dialog dcl_file))
(if (not (new_dialog "rect_array_net" dcl_id))
(progn
(alert "无法加载对话框!")
(unload_dialog dcl_id)
(vl-file-delete dcl_file)
(exit)
)
)
;; 动作处理
(action_tile "accept"
"(progn
(setq rows (get_tile \"rows\"))
(setq cols (get_tile \"cols\"))
(setq row_net (get_tile \"row_net\"))
(setq col_net (get_tile \"col_net\"))
(done_dialog 1)
)"
)
(action_tile "cancel" "(done_dialog 0)")
;; 显示对话框并处理结果
(setq result (start_dialog))
(unload_dialog dcl_id)
(vl-file-delete dcl_file)
(if (= result 1)
(progn
;; 保存到注册表
(put_reg "RectArrayNet" "Rows" rows)
(put_reg "RectArrayNet" "Cols" cols)
(put_reg "RectArrayNet" "RowNet" row_net)
(put_reg "RectArrayNet" "ColNet" col_net)
;; 转换为数值
(setq rows_val (atoi rows))
(setq cols_val (atoi cols))
(setq row_net_val (atof row_net))
(setq col_net_val (atof col_net))
;; 选择对象
(if (setq ss (ssget))
(progn
;; 获取选择集边界框
(setq bbox (get_ss_bbox_safe ss))
(if bbox
(progn
;; 计算对象尺寸
(setq pt1 (car bbox))
(setq pt2 (cadr bbox))
(setq obj_width (- (car pt2) (car pt1)))
(setq obj_height (- (cadr pt2) (cadr pt1)))
;; 计算阵列间距（对象尺寸 + 净间距）
(setq col_dist (+ obj_width col_net_val))
(setq row_dist (+ obj_height row_net_val))
;; 获取基点（左下角）
(setq base_pt pt1)
;; 验证参数
(if (and (> rows_val 0) (> cols_val 0)
(> row_dist 0) (> col_dist 0))
(progn
;; 使用ActiveX方法创建阵列
(if (create_array_activex ss rows_val cols_val row_dist col_dist base_pt)
(progn
(princ (strcat "\n成功创建了 " rows " 行 " cols " 列的矩形净间距阵列"))
(princ (strcat "\n对象尺寸: " (rtos obj_width 2 2) " x " (rtos obj_height 2 2)))
(princ (strcat "\n净间距: " row_net " x " col_net))
(princ (strcat "\n阵列间距: " (rtos col_dist 2 2) " x " (rtos row_dist 2 2)))
)
(princ "\n阵列创建失败")
)
)
(princ "\n错误: 行数、列数和间距必须大于0")
)
)
(princ "\n无法计算对象尺寸")
)
)
(princ "\n未选择对象")
)
)
)
(princ)
)
;;; 使用ActiveX方法创建阵列
(defun create_array_activex (ss rows cols row_dist col_dist base_pt /
acad_app acad_doc model_space i ent vla_obj
obj_list)
(vl-load-com)
(setq acad_app (vlax-get-acad-object))
(setq acad_doc (vla-get-activedocument acad_app))
(setq model_space (vla-get-modelspace acad_doc))
;; 将选择集中的对象转换为VLA对象列表
(setq obj_list '())
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq vla_obj (vlax-ename->vla-object ent))
(setq obj_list (cons vla_obj obj_list))
(setq i (1+ i))
)
;; 为每个对象创建阵列
(foreach obj obj_list
(if (not (vl-catch-all-error-p
(vl-catch-all-apply 'vla-ArrayRectangular
(list obj rows cols 1 row_dist col_dist 0))))
(princ (strcat "\n成功阵列对象: " (vlax-get obj 'ObjectName)))
(princ "\n阵列对象时出错")
)
)
T
)
;;; 使用复制方法手动创建阵列
(defun create_array_manual (ss rows cols row_dist col_dist base_pt /
i j copy_pt)
;; 创建副本
(setq i 0)
(while (< i rows)
(setq j 0)
(while (< j cols)
(if (not (and (= i 0) (= j 0))) ; 跳过第一个（原始对象）
(progn
(setq copy_pt (list
(+ (car base_pt) (* j col_dist))
(+ (cadr base_pt) (* i row_dist))
(caddr base_pt)
))
;; 使用entmake复制对象
(copy_entities ss base_pt copy_pt)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
T
)
;;; 使用entmake复制实体
(defun copy_entities (ss base_pt target_pt / i ent ent_data dx dy new_ent)
(setq dx (- (car target_pt) (car base_pt)))
(setq dy (- (cadr target_pt) (cadr base_pt)))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq ent_data (entget ent))
;; 复制实体并平移
(setq new_ent (copy_entity ent_data dx dy))
(setq i (1+ i))
)
)
;;; 复制单个实体并平移
(defun copy_entity (ent_data dx dy / new_data item)
(setq new_data '())
(foreach item ent_data
(cond
;; 处理插入点
((= (car item) 10)
(setq new_data (cons
(list 10
(+ (cadr item) dx)
(+ (caddr item) dy)
(cadddr item))
new_data))
)
;; 处理其他点（如直线的端点）
((= (car item) 11)
(setq new_data (cons
(list 11
(+ (cadr item) dx)
(+ (caddr item) dy)
(cadddr item))
new_data))
)
;; 保持其他数据不变
(T
(setq new_data (cons item new_data))
)
)
)
;; 反转列表以恢复原始顺序并创建新实体
(setq new_data (reverse new_data))
(entmake new_data)
)
;;; 安全获取选择集边界框
(defun get_ss_bbox_safe (ss / i ent minx miny maxx maxy coords pt)
(if (and ss (> (sslength ss) 0))
(progn
(setq i 0)
(setq minx 1e308 miny 1e308 maxx -1e308 maxy -1e308)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq coords (get_entity_points ent))
;; 处理所有坐标点
(foreach pt coords
(if (and (numberp (car pt)) (numberp (cadr pt)))
(progn
(setq minx (min minx (car pt))
miny (min miny (cadr pt))
maxx (max maxx (car pt))
maxy (max maxy (cadr pt)))
)
)
)
(setq i (1+ i))
)
;; 检查是否找到有效边界
(if (and (< minx maxx) (< miny maxy))
(list (list minx miny) (list maxx maxy))
nil
)
)
)
)
;;; 获取实体的所有点坐标
(defun get_entity_points (ent / ent_data obj_type points center radius ins_pt)
(setq ent_data (entget ent))
(setq obj_type (cdr (assoc 0 ent_data)))
(setq points '())
(cond
;; 直线
((= obj_type "LINE")
(setq points (list
(cdr (assoc 10 ent_data))
(cdr (assoc 11 ent_data))
))
)
;; 圆
((= obj_type "CIRCLE")
(setq center (cdr (assoc 10 ent_data)))
(setq radius (cdr (assoc 40 ent_data)))
(setq points (list
(list (- (car center) radius) (- (cadr center) radius))
(list (+ (car center) radius) (+ (cadr center) radius))
))
)
;; 多段线、轻量多段线
((or (= obj_type "LWPOLYLINE") (= obj_type "POLYLINE"))
(foreach item ent_data
(if (= (car item) 10)
(setq points (cons (cdr item) points))
)
)
)
;; 块参照
((= obj_type "INSERT")
(setq ins_pt (cdr (assoc 10 ent_data)))
;; 对于块参照，我们只使用插入点作为参考
(setq points (list ins_pt))
)
;; 文字、多行文字
((or (= obj_type "TEXT") (= obj_type "MTEXT"))
(setq ins_pt (cdr (assoc 10 ent_data)))
(setq points (list ins_pt))
)
;; 默认情况：尝试获取所有10组码的点
(T
(foreach item ent_data
(if (= (car item) 10)
(setq points (cons (cdr item) points))
)
)
;; 如果没有找到点，使用原点
(if (null points)
(setq points '((0 0)))
)
)
)
points
)
;;; 注册表读写函数
(defun get_reg (app key default / value)
(setq value (vl-registry-read (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\\" app) key))
(if value value default)
)
(defun put_reg (app key value)
(vl-registry-write (strcat "HKEY_CURRENT_USER\\Software\\AutoCAD\\" app) key value)
)
;;; 加载提示
(princ "\n矩形净间距阵列命令: AW")
(princ)
rouka23 发表于 2025-11-16 13:11
错误: 输入的字符串有缺陷,命令: AW ; 错误: no function definition: GET_REG, hbxymx 发表于 2025-11-16 14:03
错误: 输入的字符串有缺陷,命令: AW ; 错误: no function definition: GET_REG,
我这边没问题，你要不AI优化一下，我不为币，帮忙而已 :试试我这个，只支持块
(defun c:BH29 (/ blk blkObj blkWidth blkHeight pt1
cols rows hSpacing vSpacing i j dcl_id result
*SPB-settings* oldOsnap)
(vl-load-com)
(jiany0001)
;; 错误处理函数
(defun *error* (msg)
(if dcl_id (unload_dialog dcl_id))
(if oldOsnap (setvar "OSMODE" oldOsnap)) ; 恢复捕捉设置
(command "_.undo" "_end")
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n错误: " msg))
)
(princ)
)
;; 保存当前捕捉设置并关闭捕捉
(setq oldOsnap (getvar "OSMODE"))
(setvar "OSMODE" 0) ; 关闭所有对象捕捉
;; 读取上次的设置
(setq *SPB-settings* (getenv "SPB_SETTINGS"))
(if *SPB-settings*
(setq *SPB-settings* (read *SPB-settings*))
(setq *SPB-settings* '(3 3 0 0)) ; 默认值：列数 行数 水平间距 垂直间距
)
;; 创建对话框
(setq dcl_id (load_dialog (strcat (getvar "TEMPPREFIX") "array_dialog.dcl")))
(if (not (new_dialog "array_dialog" dcl_id))
(progn
(alert "无法加载对话框!")
(exit)
)
)
;; 初始化对话框值（使用上次的设置或默认值）
(set_tile "cols" (itoa (nth 0 *SPB-settings*)))
(set_tile "rows" (itoa (nth 1 *SPB-settings*)))
(set_tile "h_spacing" (rtos (nth 2 *SPB-settings*) 2 2))
(set_tile "v_spacing" (rtos (nth 3 *SPB-settings*) 2 2))
;; 对话框动作
(action_tile "accept"
"(setq cols (atoi (get_tile \"cols\"))
rows (atoi (get_tile \"rows\"))
hSpacing (atof (get_tile \"h_spacing\"))
vSpacing (atof (get_tile \"v_spacing\")))
(setenv \"SPB_SETTINGS\" (strcat \"(\" (itoa cols) \" \" (itoa rows) \" \"
(rtos hSpacing 2 2) \" \" (rtos vSpacing 2 2) \")\"))
(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
;; 显示对话框并获取用户输入
(setq result (start_dialog))
(unload_dialog dcl_id)
(if (= result 0)
(progn
(setvar "OSMODE" oldOsnap) ; 恢复捕捉设置
(exit)
)
)
;; 选择块并获取尺寸和基点
(while (not blk)
(setq blk (car (entsel "\n选择要阵列的块: ")))
(if (not blk) (alert "请选择有效的块参照！"))
)
(setq blkObj (vlax-ename->vla-object blk))
(vla-getBoundingBox blkObj 'minPt 'maxPt)
(setq blkWidth (- (car (vlax-safearray->list maxPt)) (car (vlax-safearray->list minPt)))
blkHeight (- (cadr (vlax-safearray->list maxPt)) (cadr (vlax-safearray->list minPt)))
pt1 (cdr (assoc 10 (entget blk)))) ; 获取块的插入点作为基点
;; 计算实际间距（块尺寸+用户指定的间距）
(setq hSpacing (+ blkWidth hSpacing)
vSpacing (+ blkHeight vSpacing))
;; 创建阵列
(command "_.undo" "_begin")
(setq i 0)
(repeat cols
(setq j 0)
(repeat rows
(if (or (> i 0) (> j 0))
(command "_.copy" blk "" pt1
(list (+ (car pt1) (* i hSpacing))
(+ (cadr pt1) (* j vSpacing))
(caddr pt1)))
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "_.undo" "_end")
;; 恢复捕捉设置
(setvar "OSMODE" oldOsnap)
(princ)
)
;; 创建临时DCL文件（间距放在右侧）
(defun create_array_dialog_dcl (/ dcl_file)
(setq dcl_file (open (strcat (getvar "TEMPPREFIX") "array_dialog.dcl") "w"))
(write-line "array_dialog : dialog {" dcl_file)
(write-line "label = \"阵列参数设置\";" dcl_file)
(write-line ": row {" dcl_file)
(write-line " : column {" dcl_file)
(write-line " : row {" dcl_file)
(write-line " : text { label = \"列数:\"; width = 10; }" dcl_file)
(write-line " : edit_box { key = \"cols\"; width = 10; }" dcl_file)
(write-line " }" dcl_file)
(write-line " : row {" dcl_file)
(write-line " : text { label = \"行数:\"; width = 10; }" dcl_file)
(write-line " : edit_box { key = \"rows\"; width = 10; }" dcl_file)
(write-line " }" dcl_file)
(write-line " }" dcl_file)
(write-line " : column {" dcl_file)
(write-line " : row {" dcl_file)
(write-line " : text { label = \"列间距:\"; width = 10; }" dcl_file)
(write-line " : edit_box { key = \"h_spacing\"; width = 10; }" dcl_file)
(write-line " }" dcl_file)
(write-line " : row {" dcl_file)
(write-line " : text { label = \"行间距:\"; width = 10; }" dcl_file)
(write-line " : edit_box { key = \"v_spacing\"; width = 10; }" dcl_file)
(write-line " }" dcl_file)
(write-line " }" dcl_file)
(write-line "}" dcl_file)
(write-line "ok_cancel;" dcl_file)
(write-line "}" dcl_file)
(close dcl_file)
)
;; 在程序开始时创建DCL文件
(create_array_dialog_dcl)
页:
[1]
2