;;------------------------=={ Multi-Polyline  }==-----------------------;;
;;                                                                      ;;
;;  This program enables the user to create objects with the appearance ;;
;;  of multilines, however, which are composed of standard polylines.   ;;
;;                                                                      ;;
;;  The program will invoke the standard AutoCAD MLINE command,         ;;
;;  allowing the user to construct the object with the real-time        ;;
;;  dynamic preview afforded by the MLINE command, with the resulting   ;;
;;  multiline automatically exploded & joined to form standard 2D       ;;
;;  polylines.                                                          ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2010  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2010-06-19                                      ;;
;;                                                                      ;;
;;  First release.                                                      ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2015-09-12                                      ;;
;;                                                                      ;;
;;  Program rewritten.                                                  ;;
;;----------------------------------------------------------------------;;

(defun c:mpl ( / *error* ent sel val var )

    (defun *error* ( msg )
        (mapcar 'setvar var val)
        (LM:endundo (LM:acdoc))
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (LM:startundo (LM:acdoc))
    (setq ent (entlast))
    (vl-cmdf "_.mline")
    (while (= 1 (logand 1 (getvar 'cmdactive)))
        (vl-cmdf "")
    )
    (if (not (eq ent (setq ent (entlast))))
        (progn
            (setq var '(cmdecho peditaccept qaflags)
                  val  (mapcar 'getvar var)
                  sel  (ssadd)
            )
            (mapcar 'setvar var '(0 1 0))
            (vl-cmdf "_.explode" ent)
            (while (setq ent (entnext ent)) (ssadd ent sel))
            (vl-cmdf "_.pedit" "_m" sel "" "_j" "" "")
        )
    )
    (*error* nil)
    (princ)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

;; ============================================== ;;
;; Cizgi Ustune Ve Dwg Yanina Exel Dosyasi Acarak ;;
;;        Poz Ve Uzunluk Bilgilerini Yazar        ;;
;;            Created By Erkan Travaci            ;;
;; ============================================== ;;

(defun c:trv (/ sy sg dt) (vl-load-com)
  (if (= (getvar 'useri5) 0) (setvar 'useri5 1))
  (setq sy (getreal (strcat "\nFirst no <" (rtos (getvar 'useri5) 2 0) "> :")))
  (if (not sy) (setq sy (getvar "useri5")) (setvar 'useri5 sy))
  (if (setq x -1 sg (ssget (list (cons 0 "line"))))
    (progn
      (setq dt (open (strcat (getvar 'dwgprefix)
        (vl-filename-base (getvar 'dwgname)) ".xls") "a"))
      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
      (repeat (sslength sg)
        (setq ob (vlax-ename->vla-object (ssname sg (setq x (1+ x))))
              ac (vla-get-Angle ob))
        (if (and (<= ac 4.71239) (> ac 1.5708)) (setq ac (+ 3.14159 ac)))
        (setq mp (polar (vlax-curve-getpointatdist ob (/
          (setq di (vla-get-Length ob)) 2)) (- ac (/ pi 2)) (getvar 'textsize)))
        (entmake (list (cons 0 "text") (cons 8 "Poz")
          (cons 1 (strcat (rtos (getvar 'useri5) 2 0) "-" (rtos di 2 0)))
          (cons 10 mp) (cons 40 (getvar 'textsize)) (cons 41 0.85)
          (cons 11 mp) (cons 50 ac) (cons 72 1) (cons 73 2)))
        (write-line (strcat (rtos sy 2 0) "\t" (rtos di 2 0)) dt)
        (setq sy (setvar 'useri5 (1+ sy)))
      )
      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
      (close dt)
    )
  ) (princ)
)