建筑面积计算小程序，有两种计算方式，一种点击封闭空间生成，另一种选择对象生成
本帖最后由 小毛草 于 2025-11-3 09:10 编辑<div class="blockcode"><blockquote>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;建筑面积计算（支持米/毫米单位）;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:fmm (/ *error* olderr oldOrthoMode oldHpAssoc oldHpSeparate
pt ent obj area centroid
areaText layerName textStyle textHeight textWidth textEnt
boundaryCreated temp-centroid lastEnt currentLayer
scaleFactor setupMode key gr newScale ss modeChanged
totalArea totalAreaText totalCentroid pts i tempCurrentLayer
minpt maxpt kword unitMode unitChanged)
; 初始化模式变量（如果不存在）
(if (not (boundp '*fmm-mode*))
(setq *fmm-mode* 1) ; 默认模式1：点击内部点
)
; 初始化单位模式变量（如果不存在）
(if (not (boundp '*fmm-unit*))
(setq *fmm-unit* "MM") ; 默认单位：毫米
)
; 定义错误处理函数
(defun *error* (msg)
(if (not (member msg '("Function cancelled" "quit / exit abort" "console break")))
(princ (strcat "\n错误: " msg))
)
; 恢复原来的设置
(if oldOrthoMode (setvar "ORTHOMODE" oldOrthoMode))
(if oldHpAssoc (setvar "HPASSOC" oldHpAssoc))
(if oldHpSeparate (setvar "HPSEPARATE" oldHpSeparate))
; 恢复当前图层
(if currentLayer (setvar "CLAYER" currentLayer))
; 恢复原来的错误处理函数
(setq *error* olderr)
(princ)
)
; 保存原来的错误处理函数
(setq olderr *error*)
; 保存当前设置
(setq oldOrthoMode (getvar "ORTHOMODE"))
(setq oldHpAssoc (getvar "HPASSOC"))
(setq oldHpSeparate (getvar "HPSEPARATE"))
; 设置填充关联
(setvar "HPASSOC" 1)
(setvar "HPSEPARATE" 1)
(setvar "ORTHOMODE" 0)
; 保存当前图层
(setq currentLayer (getvar "CLAYER"))
; 定义图层名称和属性
(setq layerName "0-P-建筑面积计算")
; 创建图层（如果不存在）
(if (not (tblsearch "LAYER" layerName))
(command "_.LAYER" "_M" layerName "_C" "6" "" "")
)
; 创建文字样式（如果不存在）
(setq textStyle "MJZJ")
(if (not (tblsearch "STYLE" textStyle))
(progn
; 使用romans.shx和HZTXT1.SHX字体
(command "_.STYLE" textStyle "romans,HZTXT1" "0" "0.7" "0" "N" "N" "N")
)
)
; 初始化比例因子（如果不存在）
(if (not (boundp '*fmm-scale*))
(setq *fmm-scale* 100.0) ; 默认比例1:100
)
; 设置默认比例因子
(setq scaleFactor *fmm-scale*)
(setq setupMode nil)
(setq modeChanged nil)
(setq unitChanged nil)
; 计算文字高度（根据比例因子调整）
; 1:100比例时文字高度为400
(setq textHeight (* 400.0 (/ scaleFactor 100.0))); 字高400按比例缩放
(setq textWidth 0.7) ; 高宽比0.7
; 显示当前设置提示
(princ (strcat "\n当前模式: " (if (= *fmm-mode* 1) "点击内部点" "选择对象")
" 当前比例: 1:" (rtos scaleFactor)
" 单位: " (if (equal *fmm-unit* "MM") "毫米" "米")
" (按A键切换模式, 按S键设置比例, 按D键切换单位, 按T键计算总面积)"))
; 等待用户输入或设置
(setq key nil)
(while (and (not key) (setq gr (grread T 15 0)))
(cond
((= (car gr) 2) ; 键盘输入
(cond
((or (= (cadr gr) 83) (= (cadr gr) 115)) ; S或s键 - 设置比例
(setq setupMode T)
(setq key T)
)
((or (= (cadr gr) 65) (= (cadr gr) 97)) ; A或a键 - 切换模式
(setq *fmm-mode* (if (= *fmm-mode* 1) 2 1))
(setq modeChanged T)
(setq key T)
)
((or (= (cadr gr) 68) (= (cadr gr) 100)) ; D或d键 - 切换单位 (修改这里)
(setq *fmm-unit* (if (equal *fmm-unit* "MM") "M" "MM"))
(setq unitChanged T)
(setq key T)
)
((or (= (cadr gr) 84) (= (cadr gr) 116)) ; T或t键 - 计算总面积
(setq key 'total)
)
((or (= (cadr gr) 13) (= (cadr gr) 32)) ; 回车或空格键
(setq key T)
)
(T ; 其他按键，继续等待
)
)
)
((= (car gr) 3) ; 鼠标左键
(setq key T)
)
((= (car gr) 11) ; 鼠标右键
(setq key T)
)
((= (car gr) 25) ; 取消操作
(exit)
)
((= (car gr) 5) ; 鼠标移动
; 忽略鼠标移动，继续等待
)
)
)
; 如果用户切换模式，重新显示提示并继续
(if (or modeChanged unitChanged)
(progn
(if modeChanged
(princ (strcat "\n已切换到" (if (= *fmm-mode* 1) "点击内部点" "选择对象") "模式"))
)
(if unitChanged
(princ (strcat "\n已切换到" (if (equal *fmm-unit* "MM") "毫米" "米") "单位"))
)
(c:fmm) ; 递归调用自身
(exit)
)
)
; 如果用户按S键设置比例
(if setupMode
(progn
(setq newScale (getreal (strcat "\n输入比例分母 <" (rtos scaleFactor) ">: ")))
(if newScale
(progn
(setq scaleFactor newScale)
(setq *fmm-scale* scaleFactor) ; 更新全局变量
; 重新计算文字高度
(setq textHeight (* 400.0 (/ scaleFactor 100.0)))
)
)
(princ (strcat "\n已设置比例: 1:" (rtos scaleFactor)))
; 设置比例后重新执行命令
(c:fmm)
(exit)
)
)
; 如果用户按T键计算总面积
(if (eq key 'total)
(progn
(if (= *fmm-mode* 1)
(fmm-total-click)
(fmm-total-select)
)
; 恢复当前图层
(setvar "CLAYER" currentLayer)
; 恢复原来的设置
(setvar "ORTHOMODE" oldOrthoMode)
(setvar "HPASSOC" oldHpAssoc)
(setvar "HPSEPARATE" oldHpSeparate)
; 恢复原来的错误处理函数
(setq *error* olderr)
(princ (strcat "\n总面积计算完成! 比例: 1:" (rtos scaleFactor) " 单位: " (if (equal *fmm-unit* "MM") "毫米" "米")))
(princ)
(exit)
)
)
; 如果用户取消，直接退出
(if (not key) (exit))
; 根据模式执行相应操作
(cond
((= *fmm-mode* 1) ; 模式1：点击内部点
(fmm-mode-click)
)
((= *fmm-mode* 2) ; 模式2：选择对象
(fmm-mode-select)
)
)
; 恢复当前图层
(setvar "CLAYER" currentLayer)
; 恢复原来的设置
(setvar "ORTHOMODE" oldOrthoMode)
(setvar "HPASSOC" oldHpAssoc)
(setvar "HPSEPARATE" oldHpSeparate)
; 恢复原来的错误处理函数
(setq *error* olderr)
(princ (strcat "\n面积计算完成! 比例: 1:" (rtos scaleFactor) " 单位: " (if (equal *fmm-unit* "MM") "毫米" "米")))
(princ)
)
; 面积计算函数（根据单位模式）
(defun calculate-area-value (area / areaValue)
(if (equal *fmm-unit* "MM")
(progn
; 毫米单位：平方毫米转换为平方米
(setq areaValue (/ area 1000000.0))
(strcat (rtos areaValue 2 2) "m2")
)
(progn
; 米单位：直接使用，已经是平方米
(setq areaValue area)
(strcat (rtos areaValue 2 2) "m2")
)
)
)
; 模式1：点击内部点计算面积
(defun fmm-mode-click ()
(princ "\n点击封闭图形内部点计算面积并标注 (右键或回车结束/按T键计算总面积): ")
; 初始化本次命令创建的多段线列表
(setq *fmm-created-polylines* '())
(setq *fmm-created-areas* 0.0)
; 循环获取多个内部点
(while (setq pt (getpoint "\n点击封闭图形内部点计算面积并标注 (右键或回车结束/按T键计算总面积): "))
; 记录当前最后一个实体
(setq lastEnt (entlast))
; 使用boundary命令创建边界区域
(command "_.BOUNDARY" pt "")
; 检查是否成功创建边界
(setq boundaryCreated nil)
; 检查是否有新实体创建
(if (not (equal lastEnt (entlast)))
(progn
(setq ent (entlast))
(if (and ent
(or
(= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget ent))) "POLYLINE")
(= (cdr (assoc 0 (entget ent))) "REGION")))
(progn
(setq boundaryCreated T)
(setq obj (vlax-ename->vla-object ent))
; 将多段线移动到指定图层
(vla-put-layer obj layerName)
(vla-put-color obj 6) ; 设置颜色为6号色（洋红色）
; 计算多段线面积
(setq area (vla-get-area obj))
; 记录本次命令创建的多段线和面积
(setq *fmm-created-polylines* (cons ent *fmm-created-polylines*))
(setq *fmm-created-areas* (+ *fmm-created-areas* area))
; 计算多段线形心
(setq centroid nil)
(cond
; 方法1: 使用getcentroid方法
((and (vlax-method-applicable-p obj 'getcentroid)
(setq temp-centroid (vl-catch-all-apply 'vla-getcentroid (list obj)))
(not (vl-catch-all-error-p temp-centroid)))
(setq centroid (vlax-safearray->list (vlax-variant-value temp-centroid)))
)
; 方法2: 对于多段线，计算顶点平均值作为近似形心
((or (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget ent))) "POLYLINE"))
(setq centroid (get-polyline-centroid ent))
)
)
; 根据单位模式计算面积值
(setq areaText (calculate-area-value area))
(if centroid
(progn
; 确保centroid是有效的点
(if (and (listp centroid) (>= (length centroid) 2)
(numberp (car centroid)) (numberp (cadr centroid)))
(progn
; 使用entmake创建文字，无需确认
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n已计算面积: " areaText " (比例: 1:" (rtos *fmm-scale*) " 单位: " (if (equal *fmm-unit* "MM") "毫米" "米") ")"))
)
(progn
(princ "\n形心坐标无效，使用点击点作为标注位置。")
; 使用entmake创建文字，无需确认
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car pt) (cadr pt) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car pt) (cadr pt) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n已计算面积: " areaText " (比例: 1:" (rtos *fmm-scale*) " 单位: " (if (equal *fmm-unit* "MM") "毫米" "米") ")"))
)
)
)
(progn
(princ "\n无法计算形心位置，使用点击点作为标注位置。")
; 使用entmake创建文字，无需确认
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car pt) (cadr pt) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car pt) (cadr pt) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n已计算面积: " areaText " (比例: 1:" (rtos *fmm-scale*) " 单位: " (if (equal *fmm-unit* "MM") "毫米" "米") ")"))
)
)
)
(progn
(princ "\n无法生成边界，请确保点击在封闭区域内。")
)
)
)
(progn
(princ "\n无法生成边界，请确保点击在封闭区域内。")
)
)
)
)
; 模式2：选择对象计算面积
(defun fmm-mode-select ()
(princ "\n选择要计算面积的对象 (多段线、圆、椭圆、面域等): ")
; 选择对象
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,REGION,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(princ (strcat "\n已选择 " (itoa (sslength ss)) " 个对象"))
; 保存当前图层
(setq tempCurrentLayer (getvar "CLAYER"))
; 处理每个选中的对象
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
; 计算对象面积
(setq area (vla-get-area obj))
; 根据单位模式计算面积值
(setq areaText (calculate-area-value area))
; 计算对象形心或中心
(setq centroid nil)
(cond
; 方法1: 使用getcentroid方法
((and (vlax-method-applicable-p obj 'getcentroid)
(setq temp-centroid (vl-catch-all-apply 'vla-getcentroid (list obj)))
(not (vl-catch-all-error-p temp-centroid)))
(setq centroid (vlax-safearray->list (vlax-variant-value temp-centroid)))
)
; 方法2: 对于多段线，计算顶点平均值作为近似形心
((or (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget ent))) "POLYLINE"))
(setq centroid (get-polyline-centroid ent))
)
; 方法3: 对于圆，使用圆心
((= (cdr (assoc 0 (entget ent))) "CIRCLE")
(setq centroid (cdr (assoc 10 (entget ent))))
)
; 方法4: 对于椭圆，使用中心点
((= (cdr (assoc 0 (entget ent))) "ELLIPSE")
(setq centroid (cdr (assoc 10 (entget ent))))
)
; 方法5: 对于样条曲线，使用控制点平均值
((= (cdr (assoc 0 (entget ent))) "SPLINE")
(setq centroid (get-spline-centroid ent))
)
; 方法6: 使用边界框中心
(t
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpt 'maxpt)))))
(progn
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt))
(setq centroid (list (/ (+ (car minpt) (car maxpt)) 2.0)
(/ (+ (cadr minpt) (cadr maxpt)) 2.0)
0.0))
)
)
)
)
(if centroid
(progn
; 确保centroid是有效的点
(if (and (listp centroid) (>= (length centroid) 2)
(numberp (car centroid)) (numberp (cadr centroid)))
(progn
; 使用entmake创建文字，无需确认
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n对象 " (itoa (1+ i)) " 面积: " areaText))
)
(progn
(princ (strcat "\n对象 " (itoa (1+ i)) " 形心坐标无效，使用边界框中心"))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpt 'maxpt)))))
(progn
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt))
(setq centroid (list (/ (+ (car minpt) (car maxpt)) 2.0)
(/ (+ (cadr minpt) (cadr maxpt)) 2.0)
0.0))
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n对象 " (itoa (1+ i)) " 面积: " areaText))
)
(princ (strcat "\n对象 " (itoa (1+ i)) " 无法计算有效位置"))
)
)
)
)
(progn
(princ (strcat "\n对象 " (itoa (1+ i)) " 无法计算形心位置，尝试使用边界框中心"))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'minpt 'maxpt)))))
(progn
(setq minpt (vlax-safearray->list minpt)
maxpt (vlax-safearray->list maxpt))
(setq centroid (list (/ (+ (car minpt) (car maxpt)) 2.0)
(/ (+ (cadr minpt) (cadr maxpt)) 2.0)
0.0))
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 textHeight)
(cons 1 areaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 6) ; 颜色6（洋红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n对象 " (itoa (1+ i)) " 面积: " areaText))
)
(princ (strcat "\n对象 " (itoa (1+ i)) " 无法计算有效位置"))
)
)
)
(setq i (1+ i))
)
; 恢复当前图层
(setvar "CLAYER" tempCurrentLayer)
)
(princ "\n未选择任何对象")
)
)
; 计算所有封闭空间的总面积（模式1）- 只计算本次命令创建的
(defun fmm-total-click ()
(princ "\n正在计算本次命令创建的所有封闭空间的总面积...")
(if (and (boundp '*fmm-created-polylines*) *fmm-created-polylines*)
(progn
(princ (strcat "\n找到 " (itoa (length *fmm-created-polylines*)) " 个本次命令创建的封闭对象"))
; 根据单位模式计算总面积
(setq totalAreaText (calculate-area-value *fmm-created-areas*))
(setq totalAreaText (strcat "总面积: " totalAreaText))
(princ (strcat "\n计算得" totalAreaText))
; 获取标注位置
(setq centroid (getpoint "\n指定总面积标注位置: "))
(if centroid
(progn
; 创建总面积标注文字
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 (* textHeight 1.2)) ; 总面积文字稍大
(cons 1 totalAreaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 1) ; 颜色1（红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n已标注" totalAreaText))
)
(princ "\n未指定标注位置，总面积未标注")
)
)
(princ "\n本次命令未创建任何封闭对象")
)
)
; 计算选择对象的总面积（模式2）
(defun fmm-total-select ()
(princ "\n请选择要计算总面积的对象: ")
; 选择对象
(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,REGION,CIRCLE,ELLIPSE,SPLINE"))))
(if ss
(progn
(princ (strcat "\n已选择 " (itoa (sslength ss)) " 个对象"))
(fmm-calculate-total-area ss)
)
(princ "\n未选择任何对象")
)
)
; 从选择集计算总面积（通用函数）
(defun fmm-calculate-total-area (ss / totalArea areaValue totalAreaText centroid i ent obj)
(setq totalArea 0.0)
; 计算总面积
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq obj (vlax-ename->vla-object ent))
(setq totalArea (+ totalArea (vla-get-area obj)))
(setq i (1+ i))
)
; 根据单位模式计算总面积
(setq totalAreaText (calculate-area-value totalArea))
(setq totalAreaText (strcat "总面积: " totalAreaText))
(princ (strcat "\n计算得" totalAreaText))
; 获取标注位置
(setq centroid (getpoint "\n指定总面积标注位置: "))
(if centroid
(progn
; 创建总面积标注文字
(entmake (list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 10 (list (car centroid) (cadr centroid) 0.0))
(cons 40 (* textHeight 1.2)) ; 总面积文字稍大
(cons 1 totalAreaText)
(cons 50 0.0)
(cons 7 textStyle)
(cons 8 layerName)
(cons 62 1) ; 颜色1（红色）
(cons 72 1) ; 水平对正：中心
(cons 11 (list (car centroid) (cadr centroid) 0.0)) ; 对齐点
(cons 73 2) ; 垂直对正：中间
))
(princ (strcat "\n已标注" totalAreaText))
)
(princ "\n未指定标注位置，总面积未标注")
)
)
; 辅助函数：计算多段线的近似形心（顶点平均值）
(defun get-polyline-centroid (ent / pts sumX sumY count pt)
(setq pts (get-polyline-points ent))
(if (and pts (> (length pts) 0))
(progn
(setq sumX 0.0 sumY 0.0 count 0)
(foreach pt pts
(if (and (listp pt) (>= (length pt) 2)
(numberp (car pt)) (numberp (cadr pt)))
(progn
(setq sumX (+ sumX (car pt))
sumY (+ sumY (cadr pt))
count (1+ count))
)
)
)
(if (> count 0)
(list (/ sumX count) (/ sumY count) 0.0)
nil
)
)
nil
)
)
; 辅助函数：获取多段线的所有顶点
(defun get-polyline-points (ent / obj pts coord i)
(setq pts '())
(if (and ent (entget ent))
(progn
(setq obj (vlax-ename->vla-object ent))
(if (vlax-property-available-p obj 'Coordinates)
(progn
(setq coord (vlax-get obj 'Coordinates))
; 使用更安全的方法检查坐标类型
(if (= (type coord) 'variant)
(progn
(setq coord (vlax-safearray->list (vlax-variant-value coord)))
; 将坐标列表转换为点列表
(setq i 0)
(while (< i (length coord))
(if (and (< (+ i 1) (length coord))
(numberp (nth i coord)) (numberp (nth (1+ i) coord)))
(setq pts (cons (list (nth i coord) (nth (1+ i) coord)) pts))
)
(setq i (+ i 2))
)
(reverse pts)
)
nil
)
)
nil
)
)
nil
)
)
; 辅助函数：计算样条曲线的近似形心（控制点平均值）
(defun get-spline-centroid (ent / pts sumX sumY count pt obj fitPoints controlPoints i)
(setq pts '())
(setq obj (vlax-ename->vla-object ent))
; 尝试获取拟合点
(if (vlax-property-available-p obj 'FitPoints)
(progn
(setq fitPoints (vlax-get obj 'FitPoints))
(if (and fitPoints (= (type fitPoints) 'variant))
(progn
(setq fitPoints (vlax-safearray->list (vlax-variant-value fitPoints)))
(setq i 0)
(while (< i (length fitPoints))
(if (and (< (+ i 2) (length fitPoints))
(numberp (nth i fitPoints)) (numberp (nth (1+ i) fitPoints)))
(setq pts (cons (list (nth i fitPoints) (nth (1+ i) fitPoints)) pts))
)
(setq i (+ i 3))
)
)
)
)
)
; 如果没有拟合点，尝试获取控制点
(if (and (null pts) (vlax-property-available-p obj 'ControlPoints))
(progn
(setq controlPoints (vlax-get obj 'ControlPoints))
(if (and controlPoints (= (type controlPoints) 'variant))
(progn
(setq controlPoints (vlax-safearray->list (vlax-variant-value controlPoints)))
(setq i 0)
(while (< i (length controlPoints))
(if (and (< (+ i 2) (length controlPoints))
(numberp (nth i controlPoints)) (numberp (nth (1+ i) controlPoints)))
(setq pts (cons (list (nth i controlPoints) (nth (1+ i) controlPoints)) pts))
)
(setq i (+ i 3))
)
)
)
)
)
; 计算形心
(if (and pts (> (length pts) 0))
(progn
(setq sumX 0.0 sumY 0.0 count 0)
(foreach pt pts
(if (and (listp pt) (>= (length pt) 2)
(numberp (car pt)) (numberp (cadr pt)))
(progn
(setq sumX (+ sumX (car pt))
sumY (+ sumY (cadr pt))
count (1+ count))
)
)
)
(if (> count 0)
(list (/ sumX count) (/ sumY count) 0.0)
nil
)
)
nil
)
)
T****6 【88VIP】【JD Plus】 等级：★★★★★：
---------------------------------------------------------------------------------
最近都流行开盲盒吗；我也发布1个盲盒
本帖最后由 tranque 于 2025-11-1 16:00 编辑
t****** 【Sam's CLUB】【Tesla VIP】等级：★★★★★★：
----------------------------------------------------------------------
最近都这么流行开盲盒么，那我也开一开。
--由 iPhone 17 Pro Max 1TB 编辑发送
能不能有演示的？ 现在Ai写的小插件还可以嘛:lol 逻辑上还有点小问题，按T出现错误。 已经更新，修改了一下！
页:
[1]