Как узнать длину мультилинии?

;********* mlen.lsp Длина мультилинии ******************
;   Разработал Олег(jr.)
(defun C:MLEN (/ mline_entity mline_length vertex_list)
(setq mline_entity
(car (entsel "\n Выберите мультилинию: ")))
(setq vertex_list (apply 'append
(mapcar (function (lambda (x)(if (eq (car x) 11)(list (cdr x)))))
(entget mline_entity))))
(setq mline_length
(apply '+
(mapcar 'distance
vertex_list
(cdr vertex_list))))
(princ "\n Длина мультилинии в мм = ") (princ mline_length)
(princ (strcat "\n Длина мультилинии в м = " (rtos (/ mline_length 1000) 2 3) "\n"))
(alert (strcat "\n Длина мультилинии = " (rtos (/ mline_length 1000) 2 3) " м."))
(princ)
)
;Для запуска ввести: mlen

^C^C^P(if (not C:MLEN) (load "mlen")) MLEN

;|================== XLS ========================================
* Опубликовано https://www.caduser.ru/forum/topic31444.html
               https://www.caduser.ru/forum/topic31669.html
* Назначение: Печать списка данных punto_datos в Excell
*             Для вывода создается новая книга
              Вывод осуществляется в первом листе
* Аргументы:
              punto_datos - список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header -  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide -  список буквенных названий стоблцов для скрытия или nil - не скрывать
                            ("A" "C" "D") - скрыть столбцы A, C, D
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B"))
|;
(defun xls ( punto_datos header Colhide / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application")
  *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
  *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
  *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
  *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)
  *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысяччей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
      (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
      (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
(DEFUN mip-put-hyperlink ( ENAME URLDescription )
 (if (eq (type ENAME) 'ENAME)(setq ENAME (vlax-ename->vla-object ENAME)))
  (vlax-for hyp (vla-get-hyperlinks ENAME)(vla-delete hyp))
  (vla-add (vla-get-hyperlinks ENAME) "about:blank" URLDescription))
(defun getnote (item / ent res dict)
  (if (and (setq ent (vlax-vla-object->ename item))(cdr (assoc 360 (entget ent)))
           (setq dict (member '(3 . "AEC_TEXT_NOTE")(entget (cdr (assoc 360 (entget ent)))))))
    (setq res (cdr (assoc 1 (entget (cdr (assoc 360 (member '(3 . "AEC_TEXT_NOTE") dict)))))))
    (setq res "")) res)
(defun Sum_Mline ( / SS ent vertex_list mline_length ret lay mline_tip)
(defun sum ( / found)(foreach item ret
 (if (and (= (strcase(car item))(strcase lay))
      (= (strcase(cadr item))(strcase mline_tip)))
 (setq found item)))
 (if found (setq ret (subst (list (nth 0 found)(nth 1 found)
 (+ (last found) mline_length)) found ret))
    (setq ret (append ret (list (list lay mline_tip mline_length))))))
(if (setq ss  (ssget "_X" (list (cons 0 "MLINE"))))
    (foreach item (vl-remove-if(function listp)(mapcar(function cadr)(ssnamex ss)))
      (setq ent (entget item))    
      (setq vertex_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
      (if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq vertex_list (append vertex_list (list (car vertex_list)))))
      (setq mline_length (apply '+ (mapcar 'distance vertex_list (cdr vertex_list))))
      (setq mline_tip (cdr(assoc 2  ent)))(setq lay (cdr(assoc 8 ent))) (sum)))
 (setq ent ret ret nil)
 (foreach item ent (if (assoc (car item) ret)
   (setq ret (subst (append (assoc (car item) ret)(list(cdr item)))
             (assoc (car item) ret) ret))
   (setq ret (append ret (list(list (car item)(cdr item)))))))
 (setq ret (vl-sort ret '(lambda(x y)(< (car x)(car y)))))
 (setq ret (mapcar '(lambda(x)(list (car x)(vl-sort(cdr x) '(lambda(x y)(<(car x)(car y)))))) ret))
ret)
;;https://www.caduser.ru/forum/topic19197.html
;;Summ MLine
(defun c:SML (/ *error* retlst)
(defun *error* (msg)(princ msg)(princ)) ;_ end of defun
(vl-load-com)
(setq retlst (Sum_Mline))
(setq retlst(mapcar '(lambda(x / lay)
         (setq lay (car x))
         (mapcar '(lambda(y)(cons lay y))
             (cadr x))
         )
    retlst))
(if (setq retlst (apply 'append retlst))
(xls retlst '("Слой" "ТИП" "Длина") nil)
(princ "\n ** Нет мультилиний **")
    )
(princ))(princ "\nНаберите SML в командной строке")

(if (setq ss  (ssget "_X" (list (cons 0 "MLINE"))))

(if (setq ss  (ssget (list (cons 0 "MLINE"))))

;|================== XLS ========================================
* Опубликовано https://www.caduser.ru/forum/topic31444.html
               https://www.caduser.ru/forum/topic31669.html
* Назначение: Печать списка данных punto_datos в Excell
*             Для вывода создается новая книга
              Вывод осуществляется в первом листе
* Аргументы:
              punto_datos - список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header -  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide -  список буквенных названий стоблцов для скрытия или nil - не скрывать
                            ("A" "C" "D") - скрыть столбцы A, C, D
                 Name_list - имя нового листа активной книги или nil - новая книга
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B"))|;
(vl-load-com)
(defun xls ( punto_datos header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length punto_datos)(setq iz_listo (car punto_datos))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq punto_datos (cdr punto_datos))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
      (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
      (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
(defun Sum_Mline ( / SS ent vertex_list mline_length ret lay mline_tip)
(defun sum ( / found)(foreach item ret
 (if (and (= (strcase(car item))(strcase lay))
    (= (strcase(cadr item))(strcase mline_tip)))
 (setq found item)))
 (if found (setq ret (subst (list (nth 0 found)(nth 1 found)
 (+ (last found) mline_length)) found ret))
    (setq ret (append ret (list (list lay mline_tip mline_length))))))
(if (setq ss  (ssget (list (cons 0 "MLINE"))))
    (foreach item (vl-remove-if(function listp)(mapcar(function cadr)(ssnamex ss)))
      (setq ent (entget item))
      (setq vertex_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
      (if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq vertex_list (append vertex_list (list (car vertex_list)))))
      (setq mline_length (apply '+ (mapcar 'distance vertex_list (cdr vertex_list))))
      (setq mline_tip (cdr(assoc 2  ent)))(setq lay (cdr(assoc 8 ent))) (sum)))
 (setq ent ret ret nil)
 (foreach item ent (if (assoc (car item) ret)
   (setq ret (subst (append (assoc (car item) ret)(list(cdr item)))
             (assoc (car item) ret) ret))
   (setq ret (append ret (list(list (car item)(cdr item)))))))
 (setq ret (vl-sort ret '(lambda(x y)(< (car x)(car y)))))
 (setq ret (mapcar '(lambda(x)(list (car x)(vl-sort(cdr x) '(lambda(x y)(<(car x)(car y)))))) ret))
ret)
;;https://www.caduser.ru/forum/topic19197.html
;;Summ MLine
(defun c:SML (/ *error* retlst)
(defun *error* (msg)(princ msg)(princ)) ;_ end of defun
(vl-load-com)
(setq retlst (Sum_Mline))
(setq retlst(mapcar '(lambda(x / lay)
       (setq lay (car x))
       (mapcar '(lambda(y)(cons lay y))
         (cadr x))
       )
  retlst))
(if (setq retlst (apply 'append retlst))
(xls retlst '("Слой" "ТИП" "Длина") nil nil)
(princ "\n ** Нет мультилиний **")
    )
(princ))(princ "\nНаберите SML в командной строке")
(defun Sum_Mline1 ( / SS ent vertex_list mline_length ret lay mline_tip mline_scale)
(defun sum ( / found)(foreach item ret
 (if (and (= (strcase(car item))(strcase lay))
    (= (strcase(cadr item))(strcase mline_tip))
    (= (caddr item) mline_scale)
          )
 (setq found item)))
 (if found (setq ret (subst (list (nth 0 found)(nth 1 found)(nth 2 found)
 (+ (last found) mline_length)) found ret))
    (setq ret (append ret (list (list lay mline_tip mline_scale mline_length))))))
(if (setq ss  (ssget  (list (cons 0 "MLINE"))))
    (foreach item (vl-remove-if(function listp)(mapcar(function cadr)(ssnamex ss)))
      (setq ent (entget item))
      (setq mline_scale (cdr(assoc 40 ent)))
      (setq vertex_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
      (if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq vertex_list (append vertex_list (list (car vertex_list)))))
      (setq mline_length (apply '+ (mapcar 'distance vertex_list (cdr vertex_list))))
      (setq mline_tip (cdr(assoc 2  ent)))(setq lay (cdr(assoc 8 ent))) (sum)))
 (setq ent ret ret nil)
 (foreach item ent (if (assoc (car item) ret)
   (setq ret (subst (append (assoc (car item) ret)(list(cdr item)))
             (assoc (car item) ret) ret))
   (setq ret (append ret (list(list (car item)(cdr item)))))))
 (setq ret (vl-sort ret '(lambda(x y)(< (car x)(car y)))))
 (setq ret (mapcar '(lambda(x)(list (car x)(vl-sort(cdr x) '(lambda(x y)(<(car x)(car y)))))) ret))
ret)
;;https://www.caduser.ru/forum/topic19197.html
;;Summ MLine
(defun c:SML1 (/ *error* retlst)
(defun *error* (msg)(princ msg)(princ)) ;_ end of defun
(vl-load-com)
(setq retlst (Sum_Mline1))
(setq retlst(mapcar '(lambda(x / lay)
       (setq lay (car x))
       (mapcar '(lambda(y)(cons lay y))
         (cadr x))
       )
  retlst))
(if (setq retlst (apply 'append retlst))
(xls retlst '("Слой" "Тип" "Масштаб" "Длина") nil nil)
(princ "\n ** Нет мультилиний **")
    )
(princ))(princ "\nНаберите SML в командной строке")