来自：[链接](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) )) ```