來自:[鏈接](http://bbs.mjtd.com/forum.php?mod=viewthread&tid=172399&extra=page%3D3%26filter%3Dtypeid%26typeid%3D107)
效果圖

源碼:
```
;;by 香田里浪人
;;;多義線邊長標注
(defun c:ng:polybz (/ obj pianju sHandle pt np gx bj np xc rr cp curve\_param ang1 文字插入點 modelSpace AddText 選擇集內實體序號 選擇集)
;;;構造text
(command "layer" "M" "邊長標注" "C" "6" "" "LT" "CONTINUOUS" "" "");設置一個標注圖層
(command "style" "hz" "宋體" "0" "" "0" "" "")
(setvar"dimzin"0);;保留小數位數時如果位數不足可以補零
(defun AddText (obj TextString InsertionPoint Height xz kb qx Alignment style / obj1 err)
(setq obj1 (vla-addtext obj TextString (vlax-3d-point InsertionPoint) Height))
(vla-put-Rotation obj1 xz)
(vla-put-ScaleFactor obj1 kb)
(vla-put-ObliqueAngle obj1 qx)
(vla-put-alignment obj1 Alignment)
(if (/= Alignment acAlignmentLeft)
(vla-put-TextAlignmentPoint obj1 (vlax-3d-point InsertionPoint))
(vla-put-InsertionPoint obj1 (vlax-3d-point InsertionPoint))
)
(VL-CATCH-ALL-APPLY 'vla-put-StyleName (list obj1 style))
obj1
)
(setq pi2 (/ pi 2))
(setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(setq bcHeight (getdist "\\n輸入標注文字高度:");文字高度
kgb 0.60 ; 寬高比
DimScale 1 ; 邊長尺度,若單位為mm,該值為1000
flag nil;nil標注在多段線走向的右側,T 左側
) ;\_ setq
(while
(setq 選擇集內實體序號 0)
(if (setq 選擇集 (ssget '((0 . "\*polyline"))))
(repeat (sslength 選擇集)
(setq pianju (\* bcHeight 0.7)) ;邊長離線距離
(setq pen-en (ssname 選擇集 選擇集內實體序號))
(setq obj (vlax-ename->vla-object pen-en)
curve\_param 0)
(while (and (setq pt (vlax-curve-getPointAtParam obj curve\_param))
(setq np (vlax-curve-getPointAtParam obj (1+ curve\_param)))
) ;\_ 結束and
(if (/= 0.0 (setq bugle (vla-GetBulge obj curve\_param)))
(progn
(setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 curve\_param))
bj (\* (atan (abs bugle)) 4)
xc (\* 0.5 (distance Pt np))
gg (abs (\* bugle xc))
rr (/ (+ (\* xc xc) (\* gg gg)) (\* 2 gg))
ang1 (angle pt np)
cp (polar Pt ang1 xc)
cp (polar midpt (angle midpt cp) rr)
邊長 (rtos (/ (\- (vlax-curve-getDistAtParam obj (1+ curve\_param)) (vlax-curve-getDistAtParam obj curve\_param)) DimScale) 2 2)
)
(if flag
(setq 文字插入點 (polar midpt (cond ((\> bugle 0)(angle midpt cp))(t (angle cp midpt))) pianju))
(setq 文字插入點 (polar midpt (cond ((\> bugle 0)(angle cp midpt))(t (angle midpt cp))) pianju))
)
(if (not (or (and (\>= ang1 0) ( ang1 (\* 1.666666 pi)) (< ang1 (\* 2.0 pi)))))
(setq ang1 (\- ang1 pi))
)
(AddText modelSpace 邊長 文字插入點 bcHeight ang1 kgb 0 acAlignmentMiddle Style)
);progn
(progn
(setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 curve\_param))
ang1 (angle pt np)
邊長 (rtos
(/
(\-
(vlax-curve-getDistAtParam obj (1+ curve\_param))
(vlax-curve-getDistAtParam obj curve\_param)
)
DimScale
) 2 2
)
)
(if flag
(setq 文字插入點 (polar midpt (+ pi2 ang1) pianju))
(setq 文字插入點 (polar midpt (\- ang1 pi2) pianju))
)
(if (not (or (and (\>= ang1 0) ( ang1 (\* 1.666666 pi)) (<= ang1 (\* 2.0 pi)))))
(setq ang1 (\- ang1 pi))
)
(AddText modelSpace 邊長 文字插入點 bcHeight ang1 kgb 0 acAlignmentMiddle Style)
);progn
) ;結束if
(setq curve\_param (1+ curve\_param))
) ; 結束while
(setq 選擇集內實體序號 (1+ 選擇集內實體序號))
)
)
(princ)
))
```
- 前言
- 概述
- autolisp簡介(初)
- 搭建編程環境
- Visual Lisp 編輯器的使用(初)
- vs code的使用
- 基本概念(初)
- 表達式
- 數據類型
- 整數類型
- 實數類型
- 字符串類型
- 列表
- 選擇集類型
- 實體名稱(ename)
- vla對象(vla-object)
- 文件描述符
- 符號和變量(初)(精)
- 源碼文件
- 變量
- 變量的類型
- 變量賦值
- 變量求值
- 預定義變量
- 數值處理
- 字符串處理
- 顯示和輸出
- 控制字符
- 列表操作
- 重點函數列表
- 尺寸標注
- 文字固定偏移
- 填充
- 填充到指定的矩形
- 計算填充面積并標注
- 其他
- 繪制任意曲線的等分線
- 原位縮放
- 修改填充基點和角度
- 批量標注多段線長度
- 統計相同直徑的圓的數量
- z坐標置0
- 生成隨機數
- 圖層
- 相交
- intersectWith無法求交點的幾種情形
- 向量和矩陣
- 向量加減乘除
- 向量長度
- 求單位向量
- 向量點積
- 向量叉積
- 命令和交互
- 調用command命令
- 多段線
- 獲取多段線頂點
- UCS
- 有關ucs的命令和系統變量
- 通過command操作ucs
- 草圖設置
- 捕捉
- 柵格
- 正交
- 對象捕捉
- 坐標系和變換(高級)
- 任意軸算法
- 坐標系
- trans
- geomcal
- autocad開發相關網站
- 小技巧匯總
- 判斷點是否在封閉圖形內
- 安裝
- acad啟動加載順序
- 安裝包制作
- 添加文件到啟動組
- 添加目錄到搜索路徑
- 對話框和圖形界面
- DCL
- openDCL
- 菜單和自定義界面
- 菜單文件
- 自定義文件
- 函數參考
- quote