;;多段线边长标注2011.4
(defun c:tt (/ obj pianju sHandle  pt np gx bj np xc  rr  cp n ang1 zjp ms AddText)
;;;构造text
  (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 ms (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
(while (setq pen (car (entsel "\n选择多段线：")))
  (setq        bcHeight 0.28 ;_ 字高
        kgb         0.8 ;_ 宽高比
        Style         "standard" ;_ 字体
        ZJWS         2 ;_ 注记位数
        DimScale 1 ;_ 边长尺度，若单位为mm,该值为1000
        flag         nil ;_ 标注在多段线走向的右侧,T 左侧
  ) ;_ setq
  (setq pianju (* bcHeight 0.7)) ;_ 边长离线距离
  (setq obj (vlax-ename->vla-object pen)
        n 0)
  (while (and (setq pt (vlax-curve-getPointAtParam obj n))
              (setq np (vlax-curve-getPointAtParam obj (1+ n)))
         ) ;_ 结束and
    (if        (/= 0.0 (setq bugle (vla-GetBulge obj n)))
      (progn
        (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
             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)
            bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale) 2 ZJWS)
              )
        (if flag
            (setq zjp (polar midpt (cond ((> bugle 0)(angle midpt cp))(t (angle  cp midpt))) pianju))
            (setq zjp  (polar midpt (cond ((> bugle 0)(angle  cp midpt))(t (angle midpt cp))) pianju))
      )
        (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (< ang1 (* 2.0 pi)))))
          (setq ang1 (- ang1 pi))
          )
        (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
      );progn
      (progn
        (setq midpt (vlax-curve-getPointAtParam obj (+ 0.5 n))
              ang1 (angle pt np)
              bc (rtos (/ (- (vlax-curve-getDistAtParam obj (1+ n)) (vlax-curve-getDistAtParam obj n)) DimScale)  2 ZJWS)
              )
        (if flag
            (setq zjp (polar midpt (+ pi2 ang1) pianju))
          (setq zjp (polar midpt (- ang1 pi2) pianju))
               )
        (if (not (or (and (>= ang1 0) (< ang1 (* 0.666666 pi))) (and (> ang1 (* 1.666666 pi)) (<= ang1 (* 2.0 pi)))))
          (setq ang1 (- ang1 pi))
          )
        (AddText ms bc  zjp  bcHeight ang1 kgb 0 acAlignmentMiddle Style)
      );progn
    ) ;_ 结束if
    (setq n (1+ n))
  ) ;_ 结束while
)
  (princ)
  )