批量標注多段線長度 · AutoLISP編程指南

來自：[鏈接](http://bbs.mjtd.com/forum.php?mod=viewthread&tid=172399&extra=page%3D3%26filter%3Dtypeid%26typeid%3D107) 效果圖 ![](https://box.kancloud.cn/d081440f44301b0ca07bbea6712b97ff_936x534.gif) 源碼： ``` ;;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) )) ```