实现水平\竖向等分板，具有记忆功能，比较实用！
;; 全局变量，用于存储上次输入的等分数、层板厚度和方向(setq *last-n* 3) ; 默认等分数为 3
(setq *last-nl* 20) ; 默认层板厚度为 20
(setq *last-direction* "Horizontal") ; 默认方向为水平
(defun C:cff ( / oldos cm pta ent ss p1 p2 p3 p4 nl n gl kl l ptn ptny ptn1 ptn1y direction)
;; 错误处理函数
(defun *error* (msg)
(setvar "osmode" oldos) ; 恢复原有对象捕捉模式
(princ (strcat "\n错误信息: " msg))
(princ)
)
;; 初始化
(setq cm (getvar "cmdecho")
oldos (getvar "osmode"))
(setvar "CMDECHO" 0)
(command "color" "bylayer")
(setvar "osmode" 443)
(command "_undo" "be")
;; 选择方向（水平或竖向），使用上次选择的方向作为默认值
(initget "Horizontal Vertical")
(setq direction (getkword (strcat "\n选择等分方向 [水平(H)/竖向(V)] <" *last-direction* ">: ")))
(if (null direction) (setq direction *last-direction*))
(setq *last-direction* direction) ; 更新全局变量
;; 选择矩形区域
(if (setq pta (getpoint "\n选择矩形区域位置 <空格>两点定位: "))
(progn
(command "-BOUNDARY" pta "")
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(if (= (length ss) 4)
(progn
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(command "_.erase" ent "")
)
(progn
(command "_.erase" ent "")
(setq p1 (getpoint "\n洞口不是矩形，手动选择矩形的第一点: "))
(setq p3 (getcorner p1 "\n第二点: "))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(command "_.erase" ent "")
)
)
)
(progn
(setq p1 (getpoint "\n第一点: "))
(setq p3 (getcorner p1 "\n第二点: "))
(setvar "osmode" 0)
(command "rectang" p1 p3)
(setq ent (entlast))
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq p1 (vlax-safearray->list maxpoint)
p3 (vlax-safearray->list minpoint))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(command "_.erase" ent "")
)
)
;; 获取层板厚度和数量（使用上次输入的值作为默认值）
(setq nl (getdist (strcat "\n层板厚度 <" (rtos *last-nl* 2 0) ">: ")))
(if (null nl) (setq nl *last-nl*))
(setq *last-nl* nl) ; 更新全局变量
(setq n (getint (strcat "\n层板数量 <" (itoa *last-n*) ">: ")))
(if (null n) (setq n *last-n*))
(setq *last-n* n) ; 更新全局变量
;; 计算等分间距
(if (eq direction "Horizontal")
(progn
(setq gl (distance p1 p4)) ; 高度
(setq kl (distance p1 p2)) ; 宽度
(setq l (/ (- gl (* nl n)) (1+ n))) ; 等分间距
(repeat n
(setq ptn (polar p1 (angle p2 p3) l))
(setq ptny (polar ptn (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
(setq ptn1 (polar ptn (angle p2 p3) nl))
(setq ptn1y (polar ptn1 (angle p4 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
(setq p1 ptn1)
)
)
(progn
(setq gl (distance p1 p2)) ; 宽度
(setq kl (distance p1 p4)) ; 高度
(setq l (/ (- gl (* nl n)) (1+ n))) ; 等分间距
(repeat n
(setq ptn (polar p1 (angle p4 p3) l))
(setq ptny (polar ptn (angle p2 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
(setq ptn1 (polar ptn (angle p4 p3) nl))
(setq ptn1y (polar ptn1 (angle p2 p3) kl))
(entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
(setq p1 ptn1)
)
)
)
;; 恢复系统变量
(setvar "osmode" oldos)
(setvar "cmdecho" cm)
(princ "\n已完成等分板布置")
(princ)
)
算是实用，不过关于记忆，应该是这样个写更好(setq a (sub a)),把记忆的代码写在子程序sub中，更简洁，另可以扩展一下，记忆字符串，记忆角度，记忆关键词。 CAD2020 无法加载！！！！ 谢谢分享!
CAD20测试 O.K. 这个有问题 我修改了
(defun *error* (msg)
(setvar "osmode" oldos) ; 恢复原有对象捕捉模式
(princ (strcat "\n错误信息: " msg))
(princ)
请问这个程序用在哪里呢:lol 试用了一下不是太好用
页:
[1]