;;AUTOCAD PROGRAMMING CHALLENGE NO. 3
;;C:LINELBL
;;Function to label lines with their length
;;Copyright 1998 by Herman Mayfarth
;;h_mayfarth@compuserve.com
;;6 Jan. 1998
;;v1.3  lines only, no error handler
;;modified 4/2/98 to sum line lengths & report total length
;;version uses cons to ssget current viewport
;;        uses polar to calculate text offset position from ctr. of line
;;        original version did not calculate this correctly
;;Written for and tested with AutoCAD R13c4 for DOS
;; global variable for line labels
(setq lbl_layer "LINE_LABEL")
(defun C:LINELBL( / ss1 ss2 i n l pt1 pt2 xmid ymid langle sstyle sf txtht
                     gap lngth rlngth tlngth inspt elist vpht curvpt)
;; handle nonsense case of zero dimscale in tiled space 
(if(and(= 0 (getvar "DIMSCALE"))(= 1 (getvar "TILEMODE")))
     (progn((alert "   Zero Dimension Scale\n   Set Tilemode = 0 or
Use a Non-Zero Dimension Scale")(exit))))
;; calculate text scale factor
(setq curvpt (getvar "CVPORT"))
(cond ((= 1 (getvar "TILEMODE")) (setq sf (getvar "DIMSCALE")));tiled space
      ((= 1 curvpt) (setq sf 1.0));in paper space
     ;; in a viewport
      (T 
         (setq ss2 (ssget "X" (list '(0 . "VIEWPORT") (cons 69 curvpt)));select vport
               vpht (cdr(assoc 41 (entget(ssname ss2 0))));set vp height
               sf (/ (getvar "VIEWSIZE") vpht));calc scale factor
       );end default  
);end cond
;; calculate text height
(setq txtht (* (getvar "DIMTXT") sf)) 
;; get current dimension text style - R13 version
(setq txtsty (getvar "DIMTXSTY"))
(setq sstyle (tblsearch "style" txtsty))
(setq gap (getvar "DIMGAP"))
;; get lines to label
(princ "\nSelect Lines to Label:")
(setq ss1 (ssget '((0 . "LINE")))
        n (sslength ss1))
(princ (strcat "\n" (itoa n)  " lines selected."))
;; main processing loop
(setq i 0)        ;initialize loop counter
(setq tlngth 0)   ;initialize length accumulator
(while (< i n)
    (princ "\nLine #")(princ i)
    (setq pt1 (assoc 10 (entget (ssname ss1 i)))
          pt2 (assoc 11 (entget (ssname ss1 i)))
          xmid (/ (+ (nth 1 pt1)(nth 1 pt2)) 2)
          ymid (/ (+ (nth 2 pt1)(nth 2 pt2)) 2)
          langle (min (angle (cdr pt1)(cdr pt2)) (angle (cdr pt2)(cdr pt1)))
          lngth (rtos(distance (cdr pt1)(cdr pt2)))
          rlngth (distance (cdr pt1)(cdr pt2))
          tlngth (+ tlngth rlngth) ;sum line lengths
    )
    (if (> langle (/ pi 2)) (setq langle (+ langle pi)));langle 2nd quadrant
    (setq inspt (polar (list xmid ymid 0) (+ langle (/ pi 2)) (* gap sf)))
    ;;build elist for text label
    (setq elist (list '(0 . "TEXT")
                       (cons 1 lngth)                  ;string - length of line
                       (cons 7 txtsty)                 ;text style
                       (cons 8 lbl_layer)              ;layer
                       (cons 10 inspt)                 ;insertion point
                       (cons 11 inspt)                 ;req'd for 72 & 73 group
                       (cons 40 txtht)                 ;text height
                       (assoc 41 sstyle)               ;width factor
                       (cons 50 langle)                ;text insertion angle
                       (cons 51 (cdr(assoc 50 sstyle)));obliquing angle
                       (assoc 71 sstyle)               ;text generation flags
                      '(72 . 1)                        ;horiz. alignment
                      '(73 . 1)                        ;vertical alignment
                 ) 
    )
    (entmake elist)
          (princ "  length = ")(princ lngth)
     (setq i (1+ i))
);end main
(princ (strcat "\nTotal length of lines = " (rtos tlngth)))
(princ)
);end LINELBL
;;load prompts
(princ "\nLinelbl loaded...")
(princ "\nType LINELBL to label lines with their length")
(princ)