设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 实现水平\竖向等分板，具有记忆功能，比较实用！
返回列表 发新帖
查看: 431|回复: 6

[源码] 实现水平\竖向等分板，具有记忆功能，比较实用！

[复制链接]
小毛草
发表于 5 天前 | 显示全部楼层 |阅读模式
  2. ;; 全局变量，用于存储上次输入的等分数、层板厚度和方向
  3. (setq *last-n* 3) ; 默认等分数为 3
  4. (setq *last-nl* 20) ; 默认层板厚度为 20
  5. (setq *last-direction* "Horizontal") ; 默认方向为水平

  7. (defun C:cff ( / oldos cm pta ent ss p1 p2 p3 p4 nl n gl kl l ptn ptny ptn1 ptn1y direction)
  8.   ;; 错误处理函数
  9.   (defun *error* (msg)
  10.     (setvar "osmode" oldos)   ; 恢复原有对象捕捉模式
  11.     (princ (strcat "\n错误信息: " msg))
  12.     (princ)
  13.   )

  15.   ;; 初始化
  16.   (setq cm (getvar "cmdecho")
  17.         oldos (getvar "osmode"))
  18.   (setvar "CMDECHO" 0)
  19.   (command "color" "bylayer")
  20.   (setvar "osmode" 443)
  21.   (command "_undo" "be")

  23.   ;; 选择方向（水平或竖向），使用上次选择的方向作为默认值
  24.   (initget "Horizontal Vertical")
  25.   (setq direction (getkword (strcat "\n选择等分方向 [水平(H)/竖向(V)] <" *last-direction* ">: ")))
  26.   (if (null direction) (setq direction *last-direction*))
  27.   (setq *last-direction* direction) ; 更新全局变量

  29.   ;; 选择矩形区域
  30.   (if (setq pta (getpoint "\n选择矩形区域位置 <空格>两点定位: "))
  31.     (progn
  32.       (command "-BOUNDARY" pta "")
  33.       (setq ent (entlast))
  34.       (setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
  35.       (if (= (length ss) 4)
  36.         (progn
  37.           (vl-load-com)
  38.           (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
  39.           (setq p1 (vlax-safearray->list maxpoint)
  40.                 p3 (vlax-safearray->list minpoint))
  41.           (setq p2 (list (car p3) (cadr p1)))
  42.           (setq p4 (list (car p1) (cadr p3)))
  43.           (command "_.erase" ent "")
  44.         )
  45.         (progn
  46.           (command "_.erase" ent "")
  47.           (setq p1 (getpoint "\n洞口不是矩形，手动选择矩形的第一点: "))
  48.           (setq p3 (getcorner p1 "\n第二点: "))
  49.           (setvar "osmode" 0)
  50.           (command "rectang" p1 p3)
  51.           (setq ent (entlast))
  52.           (vl-load-com)
  53.           (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
  54.           (setq p1 (vlax-safearray->list maxpoint)
  55.                 p3 (vlax-safearray->list minpoint))
  56.           (setq p2 (list (car p3) (cadr p1)))
  57.           (setq p4 (list (car p1) (cadr p3)))
  58.           (command "_.erase" ent "")
  59.         )
  60.       )
  61.     )
  62.     (progn
  63.       (setq p1 (getpoint "\n第一点: "))
  64.       (setq p3 (getcorner p1 "\n第二点: "))
  65.       (setvar "osmode" 0)
  66.       (command "rectang" p1 p3)
  67.       (setq ent (entlast))
  68.       (vl-load-com)
  69.       (vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
  70.       (setq p1 (vlax-safearray->list maxpoint)
  71.             p3 (vlax-safearray->list minpoint))
  72.       (setq p2 (list (car p3) (cadr p1)))
  73.       (setq p4 (list (car p1) (cadr p3)))
  74.       (command "_.erase" ent "")
  75.     )
  76.   )

  78.   ;; 获取层板厚度和数量（使用上次输入的值作为默认值）
  79.   (setq nl (getdist (strcat "\n层板厚度 <" (rtos *last-nl* 2 0) ">: ")))
  80.   (if (null nl) (setq nl *last-nl*))
  81.   (setq *last-nl* nl) ; 更新全局变量

  83.   (setq n (getint (strcat "\n层板数量 <" (itoa *last-n*) ">: ")))
  84.   (if (null n) (setq n *last-n*))
  85.   (setq *last-n* n) ; 更新全局变量

  87.   ;; 计算等分间距
  88.   (if (eq direction "Horizontal")
  89.     (progn
  90.       (setq gl (distance p1 p4)) ; 高度
  91.       (setq kl (distance p1 p2)) ; 宽度
  92.       (setq l (/ (- gl (* nl n)) (1+ n))) ; 等分间距
  93.       (repeat n
  94.         (setq ptn (polar p1 (angle p2 p3) l))
  95.         (setq ptny (polar ptn (angle p4 p3) kl))
  96.         (entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
  97.         (setq ptn1 (polar ptn (angle p2 p3) nl))
  98.         (setq ptn1y (polar ptn1 (angle p4 p3) kl))
  99.         (entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
  100.         (setq p1 ptn1)
  101.       )
  102.     )
  103.     (progn
  104.       (setq gl (distance p1 p2)) ; 宽度
  105.       (setq kl (distance p1 p4)) ; 高度
  106.       (setq l (/ (- gl (* nl n)) (1+ n))) ; 等分间距
  107.       (repeat n
  108.         (setq ptn (polar p1 (angle p4 p3) l))
  109.         (setq ptny (polar ptn (angle p2 p3) kl))
  110.         (entmake (list '(0 . "LINE") (cons 10 ptn) (cons 11 ptny)))
  111.         (setq ptn1 (polar ptn (angle p4 p3) nl))
  112.         (setq ptn1y (polar ptn1 (angle p2 p3) kl))
  113.         (entmake (list '(0 . "LINE") (cons 10 ptn1) (cons 11 ptn1y)))
  114.         (setq p1 ptn1)
  115.       )
  116.     )
  117.   )

  119.   ;; 恢复系统变量
  120.   (setvar "osmode" oldos)
  121.   (setvar "cmdecho" cm)
  122.   (princ "\n已完成等分板布置")
  123.   (princ)
  124. )


评分

参与人数 1明经币 +1 收起 理由
zm880928 + 1 论坛有你更精彩

查看全部评分

"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

chslwj521
发表于 5 天前 | 显示全部楼层
算是实用，不过关于记忆，应该是这样个写更好(setq a (sub a)),把记忆的代码写在子程序sub中，更简洁，另可以扩展一下，记忆字符串，记忆角度，记忆关键词。
回复 支持 反对

使用道具 举报

yoyrtweq
发表于 5 天前 | 显示全部楼层
CAD2020 无法加载！！！！
回复 支持 反对

使用道具 举报

yoyoho
发表于 5 天前 | 显示全部楼层
谢谢分享!
CAD20测试 O.K.
回复 支持 反对

使用道具 举报

yefei812678
发表于 5 天前 | 显示全部楼层
这个有问题 我修改了


(defun *error* (msg)
    (setvar "osmode" oldos)   ; 恢复原有对象捕捉模式
    (princ (strcat "\n错误信息: " msg))
    (princ)

回复 支持 反对

使用道具 举报

zm880928
发表于 4 天前 | 显示全部楼层
请问这个程序用在哪里呢
回复 支持 反对

使用道具 举报

oysheji
发表于 3 天前 来自手机 | 显示全部楼层
试用了一下不是太好用
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-1-22 18:46 , Processed in 0.184990 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表