提示列表有缺陷 大神给看看
;;; ------------------------------------------------------------------------;;; CAD闭合线段面积测量工具 (v1.2)
;;; ------------------------------------------------------------------------
;;; 作者：CAD技术开发团队
;;; 功能：智能检测闭合多段线并自动标注面积
;;; 版本：1.2.0
;;; 最后更新：2023-10-15
;;; ------------------------------------------------------------------------
;;; 初始化与清理
(defun libmain ()
(load (strcat (getenv "ACP_LISP_PATH") "\\closed_poly_area.lsp"))
(princ)
)
(defun libunmain ()
(unload-plugin)
(princ)
)
;;; 核心功能模块
(defun c:CLOSED-POLY-AREA ( / ent )
"主命令：自动检测闭合多段线并标注面积"
(interactive)
(setq ent (ssname (car (getssname))))
(if (null ent)
(message-box "错误：请先选择闭合多段线！" "输入错误" MB_OK | MB_ICONERROR)
(progn
(setq obj (entget ent))
(cond
;; 仅处理多段线类型
((member (cdr (assoc "TYPE" obj)) '("POLYLINE" "LWPOLYLINE"))
(when (and (check-closed-polyline obj)
(>= (length (entget obj "VERTEX")) 3))
(progn
(auto-label-poly-area obj)
(display-measurement-results obj)
(princ)
)
)
(t
(message-box (strcat "不支持类型：$" (cdr (assoc "TYPE" ent)))
"类型错误"
MB_OK | MB_ICONWARNING)
)
)
)
(princ)
)
;;; 闭合性验证模块
(defun check-closed-polyline (ent)
"使用容差法验证多段线闭合性（精度0.001单位）"
(let ((verts (entget ent "VERTEX"))
(first-pt (cdr (assoc 10 (nth 1 verts))))
(last-pt (cdr (assoc 10 (nth (length verts) verts))))
tolerance 0.001)
(and
(>= (length verts) 3)
(<= (distance first-pt last-pt) tolerance)
(equal (cdr (assoc "CLOSED" ent)) "1") ; 检查系统闭合属性
)
)
)
;;; 智能标注系统
(defun auto-label-poly-area (ent)
"自动计算并创建面积标注"
(let ((verts (entget ent "VERTEX"))
area
label-pos
style
text-height)
;; 计算几何属性
(setq area (calculate-polygonal-area verts))
(setq centroid (get-polygon-center verts))
;; 获取标注样式
(setq style (getvar "DIMSTYLE"))
(setq text-height (getvar "DIMTXTEXT"))
;; 智能定位标注位置
(setq dir (cdr (assoc "DIR" ent)))
(unless dir
(setq dir (vector-normalize (subtract-point centroid (car verts)))))
(setq label-pos (offset-point centroid dir (* text-height 1.5)))
AI写的，找AI解决呀。 ;;; ------------------------------------------------------------------------
;;; CAD闭合线段面积测量工具 (v1.2)
;;; ------------------------------------------------------------------------
;;; 作者：CAD技术开发团队
;;; 功能：智能检测闭合多段线并自动标注面积
;;; 版本：1.2.0
;;; 最后更新：2023-10-15
;;; ------------------------------------------------------------------------
;;; 初始化与清理
(defun libmain ()
(load (strcat (getenv "ACP_LISP_PATH") "\\closed_poly_area.lsp"))
(princ)
)
(defun libunmain ()
(unload-plugin)
(princ)
)
;;; 主命令函数
(defun c:CLOSED-POLY-AREA (/ ent obj)
"主命令：自动检测闭合多段线并标注面积"
(vl-load-com); 加载ActiveX支持
(setvar "CMDECHO" 0); 关闭命令回显
(setq ent (ssname (ssget ":S" '((0 . "POLYLINE,LWPOLYLINE"))) 0))
(cond
((null ent)
(alert "错误：请先选择闭合多段线！"))
(t
(setq obj (entget ent))
(cond
((member (cdr (assoc 0 obj)) '("POLYLINE" "LWPOLYLINE"))
(if (check-closed-polyline obj)
(progn
(auto-label-poly-area obj)
(display-measurement-results obj))
(alert "错误：所选多段线未闭合！")))
(t
(alert (strcat "不支持类型：" (cdr (assoc 0 obj))))))))
(setvar "CMDECHO" 1); 恢复命令回显
(princ)
)
;;; 闭合性验证函数
(defun check-closed-polyline (ent / verts first-pt last-pt tolerance)
"使用容差法验证多段线闭合性（精度0.001单位）"
(setq verts (get-vertices ent)
tolerance 0.001)
(and (> (length verts) 2)
(progn
(setq first-pt (car verts)
last-pt (last verts))
(and (<= (distance first-pt last-pt) tolerance)
(= (logand (cdr (assoc 70 ent)) 1) 1))))); 检查闭合标志
;;; 面积标注函数
(defun auto-label-poly-area (ent / verts area centroid label-pos text-height dir)
"自动计算并创建面积标注"
(setq verts (get-vertices ent)
area (calculate-polygonal-area verts)
centroid (get-polygon-center verts)
text-height (getvar "TEXTSIZE"))
;; 计算标注位置
(setq dir (or (cdr (assoc "DIR" ent))
(vector-normalize
(subtract-point centroid (car verts)))))
(setq label-pos (offset-point centroid dir (* text-height 1.5)))
;; 创建文本标注
(command "_.TEXT" "_J" "_MC" label-pos text-height 0
(strcat "面积: " (rtos area 2 2) " sq.units"))
)
;;; 获取顶点列表
(defun get-vertices (ent / verts pt)
"从多段线提取顶点坐标列表"
(setq verts '())
(if (= (cdr (assoc 0 ent)) "LWPOLYLINE")
(progn
(foreach item ent
(if (= (car item) 10)
(setq verts (append verts (list (cdr item)))))))
(progn
(setq ent (entnext ent))
(while (and ent (/= (cdr (assoc 0 (entget ent))) "SEQEND"))
(setq pt (cdr (assoc 10 (entget ent))))
(setq verts (append verts (list pt)))
(setq ent (entnext ent)))))
verts)
;;; 计算多边形面积（鞋带公式）
(defun calculate-polygonal-area (verts / sum1 sum2 i n)
"使用鞋带公式计算多边形面积"
(setq n (length verts)
sum1 0.0
sum2 0.0
i 0)
(while (< i (1- n))
(setq sum1 (+ sum1 (* (car (nth i verts)) (cadr (nth (1+ i) verts))))
sum2 (+ sum2 (* (cadr (nth i verts)) (car (nth (1+ i) verts))))
i (1+ i)))
(setq sum1 (+ sum1 (* (car (last verts)) (cadr (car verts))))
sum2 (+ sum2 (* (cadr (last verts)) (car (car verts)))))
(/ (abs (- sum1 sum2)) 2.0))
;;; 计算多边形质心
(defun get-polygon-center (verts / area xsum ysum i n pt)
"计算多边形质心"
(setq area (calculate-polygonal-area verts)
xsum 0.0
ysum 0.0
n (length verts)
i 0)
(while (< i (1- n))
(setq pt (* (+ (car (nth i verts)) (car (nth (1+ i) verts)))
(- (* (car (nth i verts)) (cadr (nth (1+ i) verts)))
(* (cadr (nth i verts)) (car (nth (1+ i) verts)))))
xsum (+ xsum pt)
ysum (+ ysum pt)
i (1+ i)))
(setq pt (* (+ (car (last verts)) (car (car verts)))
(- (* (car (last verts)) (cadr (car verts)))
(* (cadr (last verts)) (car (car verts)))))
xsum (+ xsum pt)
ysum (+ ysum pt))
(list (/ xsum (* 6.0 area)) (/ ysum (* 6.0 area))))
;;; 向量标准化
(defun vector-normalize (vec / mag)
"将向量标准化为单位向量"
(setq mag (sqrt (apply '+ (mapcar '* vec vec))))
(if (> mag 0)
(mapcar '(lambda (x) (/ x mag)) vec)
vec))
;;; 点坐标相减
(defun subtract-point (p1 p2)
"计算两点之间的向量"
(mapcar '- p1 p2))
;;; 点沿方向偏移
(defun offset-point (pt dir dist)
"沿指定方向偏移点"
(mapcar '+ pt (mapcar '(lambda (x) (* x dist)) dir)))
;;; 显示测量结果
(defun display-measurement-results (obj / area)
"在命令行显示测量结果"
(setq area (calculate-polygonal-area (get-vertices obj)))
(princ (strcat "\n测量结果 - 面积: " (rtos area 2 2) " 平方单位"))
(princ))
;;; 程序加载提示
(princ "\nCLOSED-POLY-AREA 加载完成。输入 CLOSED-POLY-AREA 开始使用。")
(princ)
biya 发表于 2025-3-15 06:45
你怎么一眼看出来的是AI?引号全是3对？
你觉得中国写代码的。有人会这样命名函数的？
(progn
(auto-label-poly-area obj)
(display-measurement-results obj)
(princ)
)
(setq dir (vector-normalize (subtract-point centroid (car verts))))) 本帖最后由 tryhi 于 2025-3-13 16:21 编辑
你数一下有多少左括号（帮你数了94个），再数一下有多少个右括号（又帮你数了90个），不就知道问题在哪了吗？
让AI写代码，然后写出来的自己都懒得花时间研究，这哪还有一点编程学习的样子。 message-box when let都是啥玩意？ xyp1964 发表于 2025-3-13 17:10
message-box when let都是啥玩意？
一眼早年间AI的作品。 xyp1964 发表于 2025-3-13 17:10
message-box when let都是啥玩意？
我还以为只有我不认识这些函数:o-o-o-o- 神奇的代码 xyp1964 发表于 2025-3-13 17:10
message-box when let都是啥玩意？
Common Lisp函数
页:
[1]
2