填充面积提示字符有缺陷怎么办大神给看看
本帖最后由 磐舍 于 2025-3-13 13:39 编辑;;; ------------------------------------------------------------------------
;;; CAD Measurement Toolkit (v1.0)
;;; ------------------------------------------------------------------------
;;; 作者：AutoCAD Lisp开发团队
;;; 功能：多实体类型测量与分析工具
;;; 版本：1.0.0
;;; ------------------------------------------------------------------------
(defun c:MEASURE-TOOL ( / cmd )
(setq cmd (readstring "CAD Measurement Toolkit\n请选择操作模式:\n"
" 单个对象测量 批量对象测量 面积计算 退出")
:input-filter "(progn (setq input (downcase (strcase cmd))) (cond ((member input '("s" "m" "a" "q")) input) (t nil))))))
(cond
((or (equal cmd "s") (equal cmd "S"))
(single-object-measurement))
((or (equal cmd "m") (equal cmd "M"))
(batch-object-measurement))
((or (equal cmd "a") (equal cmd "A"))
(command "AREA"))
((or (equal cmd "q") (equal cmd "Q"))
(princ))
)
(princ)
)
;;;
;;; 核心测量功能模块
;;; ------------------------------------------------------------
(defun single-object-measurement ()
(command "SELBOX")
(when (and (eq (getvar "SelCount")) 1)
(let ((ent (entget (ssname (car (getssname))))))
(cond
((member (cdr (assoc "TYPE" ent)) '("POLYLINE" "LWPOLYLINE"))
(polyline-measurement ent))
((member (cdr (assoc "TYPE" ent)) '("CIRCLE"))
(circle-measurement ent))
((member (cdr (assoc "TYPE" ent)) '("ARC"))
(arc-measurement ent))
(t
(princ (strcat "不支持测量类型: " (cdr (assoc "TYPE" ent)))))
)
)
)
(princ)
)
(defun batch-object-measurement ()
(command "SSIZE")
(when (and (eq (getvar "SelCount")) (> (getvar "SelCount") 0))
(mapcar 'single-object-measurement (getssname (1- (getvar "SelCount")))))
)
(princ)
)
;;; 多段线测量（支持闭合曲线）
(defun polyline-measurement (ent)
(let ((verts (entget ent "VERTEX")))
(unless verts
(princ "无效的多段线！")
(return-from polyline-measurement))
(setq area 0.0
perimeter 0.0)
(vlax-for i (isequence (length verts))
(setq j (mod i (length verts)))
(setq p1 (cdr (assoc 10 (nth i verts))))
(setq p2 (cdr (assoc 10 (nth j verts))))
;; 计算线段属性
(setq dx (- (car p2) (car p1))
dy (- (cadr p2) (cadr p1)))
(setq seg-length (sqrt (+ (* dx dx) (* dy dy))))
(setq perimeter (+ perimeter seg-length))
;; 面积计算（改进版鞋带公式）
(setq area (+ area (* (car p1) (cadr p2))
(- (car p2) (car p1)) (* (cadr p1) (cadr p2))))))
(setq area (abs area))
(format t "\n对象: %s\n" (cdr (assoc "NAME" ent)))
(format t "测量结果:\n")
(format t "面积: %.2f 平方单位\n" area)
(format t "周长: %.2f 单位\n" perimeter)
(format t "顶点数: %d\n" (length verts))
(princ)
))
;;; 圆形测量（增加直径计算）
(defun circle-measurement (ent)
(let ((radius (cdr (assoc 10 (entget ent))))))
(unless radius
(princ "无效的圆形！")
(return-from circle-measurement))
(setq circumference (* 2 * pi * radius)
diameter (* 2 radius)
area (* pi * (* radius radius)))
(format t "\n对象: %s\n" (cdr (assoc "NAME" ent)))
(format t "测量结果:")
(format t "半径: %.2f 单位" radius)
(format t "直径: %.2f 单位" diameter)
(format t "周长: %.2f 单位" circumference)
(format t "面积: %.2f 平方单位" area)
(princ)
))
;;; 圆弧测量（增加角度百分比显示）
(defun arc-measurement (ent)
(let ((radius (cdr (assoc 10 (entget ent))))
(start-angle (cdr (assoc 51 (entget ent))))
(end-angle (cdr (assoc 52 (entget ent))))
(center (cdr (assoc 10 (entget (findent (cdr (assoc 36 ent))))))))
(unless (and radius start-angle end-angle center)
(princ "无效的圆弧参数！")
(return-from arc-measurement))
(setq angle-span (- end-angle start-angle)
sector-area (* 0.5 * pi * (* radius radius) * (abs angle-span)/360))
chord-length (* 2 * radius * (sin (/ angle-span 2)*pi/180)))
arc-length (* radius * (abs angle-span)/360 * 2 * pi))
angle-percent (* 100.0 (abs angle-span)/360))
(format t "\n对象: %s\n" (cdr (assoc "NAME" ent)))
(format t "测量结果:")
(format t "半径: %.2f 单位" radius)
(format t "圆心: %s" (strcat (rtos (car center)) "," (rtos (cadr center))))
(format t "起始角: %.2f°" start-angle)
(format t "终止角: %.2f°" end-angle)
(format t "跨度: %.2f° (%.1f%%)" angle-span angle-percent)
(format t "弦长: %.2f 单位" chord-length)
(format t "弧长: %.2f 单位" arc-length)
(format t "扇形面积: %.2f 平方单位" sector-area)
(princ)
))
;;;
;;; 工具增强功能
;;; ------------------------------------------------------------
(defun initialize-plugin ()
(princ "CAD Measurement Toolkit 已加载")
(command "UNLOAD" "MEASURE-FACE") ; 避免命令冲突
(defun c:MEASURE-TOOL () (interactive) (c:MEASURE-TOOL)))
(princ)
)
(defun unload-plugin ()
(princ "CAD Measurement Toolkit 已卸载")
(fmakunintern "c:MEASURE-TOOL")
(princ)
)
;;;
;;; 初始化与清理
;;; ------------------------------------------------------------
(defun libmain ()
(initialize-plugin)
(princ)
)
(defun libunmain ()
(unload-plugin)
(princ)
)
(provide "MEASURE-TOOL")
你数一下有多少个双引号（少了1个），再数一下有多少个左括号，再数一下有多少个右括号（比左括号少两个），不就知道问题在哪了吗 al 硬套 cl 函数
页:
[1]