填充面积提示字符有缺陷怎么办大神给看看

磐舍

;;; ------------------------------------------------------------------------
;;; CAD Measurement Toolkit (v1.0)
;;; ------------------------------------------------------------------------
;;; 作者：AutoCAD Lisp开发团队
;;; 功能：多实体类型测量与分析工具
;;; 版本：1.0.0
;;; ------------------------------------------------------------------------

(defun c:MEASURE-TOOL ( / cmd )
  (setq cmd (readstring "CAD Measurement Toolkit\n请选择操作模式:\n"
                        " [S] 单个对象测量  [M] 批量对象测量  [A] 面积计算  [Q] 退出")
                        :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")

tryhi

你数一下有多少个双引号（少了1个），再数一下有多少个左括号，再数一下有多少个右括号（比左括号少两个），不就知道问题在哪了吗

vitalgg

al 硬套 cl 函数