[^-^]:http://bbs.mjtd.com/thread-107008-1-1.html
根據網上源碼修改
效果圖:

源碼:
```
(vl-load-com)
(Defun c:AutoHatchArea (/ DATA I LL MID MTO MTXT NUM
OBJ OID PNAME SS TXT TXT0 TXT1 UR
VAL
areaList areaNumList areaEle areaList pname area
)
(setq
mtxt (list (cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 1 " ")
(list 10 0.0 0.0 0.0)
(cons 40 5.0) ; 文字高度
(cons 50 0.0)
(cons 62 1)
(cons 71 5)
(cons 72 5)
(cons 90 1)
(cons 45 1.2)
)
)
(setq areaList (tcx 1))
(if (setq i -1)
(repeat (length areaList)
(setq areaEle (nth (setq i (1+ i)) areaList)) ;取出一個面積項
(setq pname (car areaEle)) ;圖案名稱
(setq area (nth 1 areaEle)) ;面積
(setq midPoint (nth 2 areaEle));填充包圍框的中心點
;;對相同圖案名稱的項進行編號
(if (null (setq areaNum (cdr (assoc pname areaNumList))))
(setq areaNumList (cons (cons pname 1) areaNumList))
(progn
(setq areaNumList (subst (cons pname (1+ areaNum)) (cons pname areaNum) areaNumList))
)
)
(setq txt0 (strcat pname "-" (itoa (cdr (assoc pname areaNumList)))));圖案名稱 字符串
(setq txt1 (strcat "A=" (rtos area) "m2")) ;面積字符串
(setq
mto (entmake mtxt)
mto (vlax-ename->vla-object (entlast))
)
(vla-put-textstring mto (strcat txt0 "\\\\P" txt1))
(vla-put-insertionPoint mto (vlax-3d-point midPoint))
;(vla-update obj)
)
)
(princ)
)
;;返回填充的圖案名稱和面積
(defun tcx (
type0 ;0-將相同圖案名稱的累加在一起;1-相同圖案名稱的也分別計算
/ thisdrawing modelspace cset hname area ll na centerPoint minExt maxExt)
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
modelspace (vla-get-modelspace thisdrawing)
)
(if (ssget '((0 . "hatch")))
(progn
(vlax-for obj (vla-get-activeselectionset thisdrawing)
(setq hname (vla-get-patternname obj)
area (/ (vl-catch-all-apply ' vla-get-area (list obj) ) 1000000)
)
(vla-getboundingbox obj 'minExt 'maxExt)
(setq minExt (vlax-safearray->list minExt))
(setq maxExt (vlax-safearray->list maxExt))
(setq midPoint
(list
(/ (+ (car minExt) (car maxExt)) 2)
(/ (+ (cadr minExt) (cadr maxExt)) 2)))
(if (\= (type area) 'REAL)
(if (\= type0 0)
(if ll
(if (setq na (assoc hname ll))
(setq ll (subst (list hname (+ area (cadr na)) midPoint) na ll))
(setq ll (cons (list hname area midPoint) ll))
)
(setq ll (cons (list hname area midPoint) ll))
)
(progn
(setq ll (cons (list hname area midPoint) ll))
)
)
)
)
)
)
(princ ll)
)
```
- 前言
- 概述
- autolisp簡介(初)
- 搭建編程環境
- Visual Lisp 編輯器的使用(初)
- vs code的使用
- 基本概念(初)
- 表達式
- 數據類型
- 整數類型
- 實數類型
- 字符串類型
- 列表
- 選擇集類型
- 實體名稱(ename)
- vla對象(vla-object)
- 文件描述符
- 符號和變量(初)(精)
- 源碼文件
- 變量
- 變量的類型
- 變量賦值
- 變量求值
- 預定義變量
- 數值處理
- 字符串處理
- 顯示和輸出
- 控制字符
- 列表操作
- 重點函數列表
- 尺寸標注
- 文字固定偏移
- 填充
- 填充到指定的矩形
- 計算填充面積并標注
- 其他
- 繪制任意曲線的等分線
- 原位縮放
- 修改填充基點和角度
- 批量標注多段線長度
- 統計相同直徑的圓的數量
- z坐標置0
- 生成隨機數
- 圖層
- 相交
- intersectWith無法求交點的幾種情形
- 向量和矩陣
- 向量加減乘除
- 向量長度
- 求單位向量
- 向量點積
- 向量叉積
- 命令和交互
- 調用command命令
- 多段線
- 獲取多段線頂點
- UCS
- 有關ucs的命令和系統變量
- 通過command操作ucs
- 草圖設置
- 捕捉
- 柵格
- 正交
- 對象捕捉
- 坐標系和變換(高級)
- 任意軸算法
- 坐標系
- trans
- geomcal
- autocad開發相關網站
- 小技巧匯總
- 判斷點是否在封閉圖形內
- 安裝
- acad啟動加載順序
- 安裝包制作
- 添加文件到啟動組
- 添加目錄到搜索路徑
- 對話框和圖形界面
- DCL
- openDCL
- 菜單和自定義界面
- 菜單文件
- 自定義文件
- 函數參考
- quote