Re: Список площадей выделенных полилиний в тектовое окно (файл)

> iv
Ошибочка вышла

(defun C:-SELMYNOTE ( / sset dict-name sset1 mask dict)(vl-load-com)
(initget "NOMSEKC TYPESEKC PRIMSEKC AEC_TEXT_NOTe" )
(setq dict-name (getstring "Имя словаря для выделения [NOMSEKC/TYPESEKC/PRIMSEKC/AEC_TEXT_NOTE] <Nomsekc>: "))
(if (= dict-name "")(setq dict-name "NomSekc"))
(setq dict-name (strcase dict-name))
(setq mask (getstring t "\nМаска поиска (типа Склад*) <пусто>: ")
      mask (vl-string-trim " " (strcase mask))
      )
    (setq sset (ssget "_I"))
    (setq sset1 nil sset1 (ssadd))
(if (or sset (setq sset (ssget "_:L")))
  (progn
 (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
   (if (and (vlax-write-enabled-p (vlax-ename->vla-object item))
            (setq dict (cdr (assoc 360 (entget item))))
            (member (cons 3  dict-name)(entget dict))
            (wcmatch (strcase (vl-string-trim " " (DictGetFromEnameByName item dict-name))) mask))
       (ssadd item sset1))
     )
   (if (> (sslength sset1) 0)(sssetfirst sset1 sset1)(sssetfirst nil nil))))
(setq sset1 nil sset nil)(princ))

Re: Список площадей выделенных полилиний в тектовое окно (файл)

> VVA
Работоспособность повысилась до 1-го варианта :)
Однако "пустые" по прежнему не ищет :(

Re: Список площадей выделенных полилиний в тектовое окно (файл)

> iv
Только что проверил - ищет. Мы, наверное, по разному понимаем "пусто". Команда создает пустой словарь.

(defun C:MYNOTE1 ( / sset hyptxt dict-name)(vl-load-com)
(initget "NOMSEKC TYPESEKC PRIMSEKC" )
(setq dict-name (strcase(getstring "Имя словаря [NOMSEKC/TYPESEKC/PRIMSEKC] <NOMSEKC>: ")))
(if (= dict-name "")(setq dict-name "NOMSEKC"))
(setq hyptxt (getstring t (strcat "\nОписание объекта для " dict-name " <нет>: ")))
(setq hyptxt (VL-STRING-TRIM " " hyptxt))
(if (and (setq sset (ssget "_:L")))
 (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
   (DictAddToEnameByName item dict-name hyptxt)))(princ))

Работоспособность повысилась до 1-го варианта :)

Немного поднялась - обрабатывает предварительный выбор
А вообще пришли почтой dwg с пустыми словарями

Re: Список площадей выделенных полилиний в тектовое окно (файл)

Мы по разному трактовали "словарь не заполнен"
Я - имя задано, значение = ""
Ты - нет такого имени
Правило:
1. Незначащие пробелы справа и слева в значении словарей и маске поиска удаляются
2. Словарь считается пустым, если
2.a. Имя задано, значение = "" (см. п. 1.)
2.b. Не задан словарь

(defun C:-SELMYNOTE ( / sset dict-name sset1 mask dict)(vl-load-com)
(initget "NOMSEKC TYPESEKC PRIMSEKC AEC_TEXT_NOTe" )
(setq dict-name (getstring "Имя словаря для выделения [NOMSEKC/TYPESEKC/PRIMSEKC/AEC_TEXT_NOTE] <Nomsekc>: "))
(if (= dict-name "")(setq dict-name "NomSekc"))
(setq dict-name (strcase dict-name))
(setq mask (getstring t "\nМаска поиска (типа Склад*) <пусто>: ")
      mask (vl-string-trim " " (strcase mask))
      )
    (setq sset (ssget "_I"))
    (setq sset1 nil sset1 (ssadd))
(if (or sset (setq sset (ssget "_:L")))
  (progn
 (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
   (if (and (vlax-write-enabled-p (vlax-ename->vla-object item))
            (wcmatch (strcase (vl-string-trim " " (DictGetFromEnameByName item dict-name))) mask))
       (ssadd item sset1))
     )
   (if (> (sslength sset1) 0)(sssetfirst sset1 sset1)(sssetfirst nil nil))))
(setq sset1 nil sset nil)(princ))

Re: Список площадей выделенных полилиний в тектовое окно (файл)

> VVA
Ну да! То что надо.
А можно первый вариант функции совместить с Set_note?
Т.е. превентивное высвечивание объектов имеющих определенное значение в определенном словаре.
При запуске ф-ии например T2N-TypeSekc, и выборе какого то значения например "Коридор" вместе с предложением выбрать объект подсвечиваются все объекты чертежа которые уже имеют такое значение в этом словаре?

Re: Список площадей выделенных полилиний в тектовое окно (файл)

Добрый день! Скажите пожалуйста, возможно ли к данному коду

VVA пишет:

> iv
Измененный вариант. Данные добавляются в текущую книгу в новый лист. Если текущей книги нет, она создается. Лист именуется "Имя_файла&amp;Имя ф-ции (вариант)"
Напpимер:
Drawing1&amp;SML
Drawing1&amp;SML (1)

;|================== XLS ========================================
* Опубликовано [url=https://www.caduser.ru/forum/topic31444.html]https://www.caduser.ru/forum/topic31444.html[/url]
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; [url=https://www.caduser.ru/forum/topic31669.html]https://www.caduser.ru/forum/topic31669.html[/url]
* Назначение: Печать списка данных punto_datos в Excell
*&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Для вывода создается новая книга
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Вывод осуществляется в первом листе
* Аргументы:
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;punto_datos - список списков данных (LIST) вида
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Каждый список вида (Value1 Value2 ... VlalueN) записывается
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;header -&nbsp;&nbsp;список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Если header nil, принимается ("X" "Y" "Z")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Colhide -&nbsp;&nbsp;список буквенных названий стоблцов для скрытия или nil - не скрывать
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;("A" "C" "D") - скрыть столбцы A, C, D
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Name_list - имя нового листа активной книги или nil - новая книга
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(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)
&nbsp;&nbsp;TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
&nbsp;&nbsp;Res (strcat (chr (+ 64 TMP)) Res)&nbsp;&nbsp;N&nbsp;&nbsp; (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
&nbsp;&nbsp;(setq&nbsp;&nbsp;*AplExcel*&nbsp;&nbsp;&nbsp;&nbsp; (vlax-get-or-create-object "Excel.Application"))
&nbsp;&nbsp;(if (setq *New-Book*&nbsp;&nbsp;(vlax-get-property *AplExcel* "ActiveWorkbook"))
&nbsp;&nbsp;&nbsp;&nbsp;(setq *Books-Colection*&nbsp;&nbsp;(vlax-get-property *AplExcel* "Workbooks")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; *Sheet#1*&nbsp;&nbsp;&nbsp;&nbsp; (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*&nbsp;&nbsp;(vlax-get-property *AplExcel* "Workbooks")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;*New-Book*&nbsp;&nbsp;&nbsp;&nbsp; (vlax-invoke-method *Books-Colection* "Add")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;*Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; *Sheet#1*&nbsp;&nbsp;&nbsp;&nbsp; (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*&nbsp;&nbsp;&nbsp;&nbsp; (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (strcat (vl-filename-base(getvar "DWGNAME")) "&amp;" 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)
&nbsp;&nbsp;(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" ".")&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;_разделитель тысячей
(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&nbsp;&nbsp;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"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell&nbsp;&nbsp;'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"
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell&nbsp;&nbsp;'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)))
&nbsp;&nbsp;(vlax-for hyp (vla-get-hyperlinks ENAME)(vla-delete hyp))
&nbsp;&nbsp;(vla-add (vla-get-hyperlinks ENAME) "about:blank" URLDescription))
(defun getnote (item / ent res dict)
&nbsp;&nbsp;(if (and (setq ent (vlax-vla-object->ename item))(cdr (assoc 360 (entget ent)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq dict (member '(3 . "AEC_TEXT_NOTE")(entget (cdr (assoc 360 (entget ent)))))))
&nbsp;&nbsp;&nbsp;&nbsp;(setq res (cdr (assoc 1 (entget (cdr (assoc 360 (member '(3 . "AEC_TEXT_NOTE") dict)))))))
&nbsp;&nbsp;&nbsp;&nbsp;(setq res "")) res)
(defun setnote ( ent note_value / dict new_note edict lst aec_note xdic)
(setq xdic (vla-getextensiondictionary (vlax-ename->vla-object ent)))
(if (setq dict (cdr (assoc 360 (entget ent))))
&nbsp;&nbsp;(setq edict (entget dict)))
(setq lst (list
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(0 . "AEC_TEXT_NOTE")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(102 . "{ACAD_REACTORS")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(cons 330 dict)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(102 . "}")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(cons 330 dict)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(100 . "AecDbObject")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(102 . "{AEC_SUBOBJECT")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(300 . "AecImpObj")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(100 . "AecImpObj")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(3 . "")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(102 . "AEC_SUBOBJECT}")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(102 . "{AEC_NULLOBJECT}")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(100 . "AecDbTextNote")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(cons 1 note_value)))
(if (null(setq new_note (entmakex lst))) ;_Нет объекта AEC_TEXT_NOTE
&nbsp;&nbsp;(progn
&nbsp;&nbsp;(setq lst (list
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(0 . "XRECORD")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(cons 330 dict)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'(100 . "AcDbXrecord")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(cons 1 note_value)))
&nbsp;&nbsp;(setq new_note (entmakex lst))
&nbsp;&nbsp;)
&nbsp;&nbsp;)
(if new_note (progn
(if (setq aec_note(member '(3 . "AEC_TEXT_NOTE") edict))
&nbsp;&nbsp;(progn
&nbsp;&nbsp;&nbsp;&nbsp;(setq edict (vl-remove (car aec_note) edict))
&nbsp;&nbsp;&nbsp;&nbsp;(setq edict (vl-remove (cadr aec_note) edict))))
(setq edict (append edict (list (cons 3 "AEC_TEXT_NOTE")(cons 360 new_note))))
(entmod edict)
(if (null (assoc 360 (entget ent)))
&nbsp;&nbsp;(entmod (append (entget ent)(list(cons 360 dict))))))))
(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))
 &nbsp;&nbsp;&nbsp; (= (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))
&nbsp;&nbsp;&nbsp;&nbsp;(setq ret (append ret (list (list lay mline_tip mline_length))))))
(if (setq ss&nbsp;&nbsp;(ssget (list (cons 0 "MLINE"))))
&nbsp;&nbsp;&nbsp;&nbsp;(foreach item (vl-remove-if(function listp)(mapcar(function cadr)(ssnamex ss)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq ent (entget item))&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq vertex_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 11 (car x)))) ent)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if (= 2 (logand 2 (cdr(assoc 71 ent))))(setq vertex_list (append vertex_list (list (car vertex_list)))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq mline_length (apply '+ (mapcar 'distance vertex_list (cdr vertex_list))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq mline_tip (cdr(assoc 2&nbsp;&nbsp;ent)))(setq lay (cdr(assoc 8 ent))) (sum)))
 (setq ent ret ret nil)
 (foreach item ent (if (assoc (car item) ret)
&nbsp;&nbsp; (setq ret (subst (append (assoc (car item) ret)(list(cdr item)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (assoc (car item) ret) ret))
&nbsp;&nbsp; (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)
(defun Sum_Blk ( / SS ret lay bname bcount ent)
(defun sum ( / found)(foreach item ret
 (if (and (= (strcase(car item))(strcase lay))(= (strcase(cadr item))(strcase bname)))(setq found item)))
 (if found (setq ret (subst (list (nth 0 found)(nth 1 found)
 (+ (last found) bcount)) found ret))
&nbsp;&nbsp;&nbsp;&nbsp;(setq ret (append ret (list (list lay bname bcount))))))
(if (setq ss&nbsp;&nbsp;(ssget (list (cons 0 "INSERT"))))
&nbsp;&nbsp;&nbsp;&nbsp;(foreach item (mapcar 'vlax-ename->vla-object(vl-remove-if(function listp)(mapcar(function cadr)(ssnamex ss))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq lay (vla-get-layer item) bcount 1)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq bname (cond ((and (vlax-property-available-p item 'isdynamicblock)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (= (vla-get-isdynamicblock item) :vlax-true)) ;_ end of and
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(vla-get-effectivename item))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (t (vla-get-name item))) ;_ end of cond
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bname (strcat "'" bname)) (sum)))
 (setq ent ret ret nil)
 (foreach item ent (if (assoc (car item) ret)
&nbsp;&nbsp; (setq ret (subst (append (assoc (car item) ret)(list(cdr item)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (assoc (car item) ret) ret))
&nbsp;&nbsp; (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)
;;;[url=http://dwg.ru/forum/viewtopic.php?t=8291&amp;postdays=0&amp;postorder=asc&amp;start=30]http://dwg.ru/forum/viewtopic.php?t=8...c&amp;start=30[/url]
(defun mip_MTEXT_Unformat ( Mtext / text Str )(setq Text "")
&nbsp;&nbsp; (while (/= Mtext "")(cond
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq Mtext (substr Mtext 3) Text&nbsp;&nbsp; (strcat Text Str)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq Mtext (substr Mtext 3)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (strcase (substr Mtext 1 2)) "\\P")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if (or(= " " (substr Text (strlen Text)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (= " " (substr Mtext 3 1)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq Mtext (substr Mtext 3))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((wcmatch (strcase (substr Mtext 1 2)) "\\S")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq Str&nbsp;&nbsp; (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Text&nbsp;&nbsp;(strcat Text (vl-string-translate "#^\\" "/^\\" Str))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Mtext (substr Mtext (+ 4 (strlen Str)))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;)) Text)
(defun add_note ( note_func / d obj ent adoc *error* undo lays Flag hyptxt sset Multiple str)
&nbsp;&nbsp;(defun *error* (msg)(princ msg)(vla-EndUndoMark adoc))
&nbsp;&nbsp;(vl-load-com)(setq adoc (vla-get-activedocument (vlax-get-acad-object))
&nbsp;&nbsp;lays (vla-get-layers adoc))(vla-StartUndoMark adoc)(setvar "CMDECHO" 0)
&nbsp;&nbsp;(setq d (getvar "UNDOCTL"))
&nbsp;&nbsp;(cond ((= d 0) (vl-cmdf "_.UNDO" "_All"))
&nbsp;&nbsp;&nbsp;&nbsp;((= d 3) (vl-cmdf "_.UNDO" "_Control" "_All"))
&nbsp;&nbsp;&nbsp;&nbsp;(t nil)) ;_ end of cond
&nbsp;&nbsp;(setq undo 0 Flag t Multiple nil str "\nОдин-> Выберите текст [" hyptxt "")
&nbsp;&nbsp;(while Flag (if Multiple (progn(princ "\nТекущее значение заметки <")(princ hyptxt)(princ ">\n")))
&nbsp;&nbsp;(initget "Undo Отмени Несколько Multiple Exit Выход оДин One _Undo Undo Multiple Multiple Exit Exit One One")
&nbsp;&nbsp;&nbsp;&nbsp;(setq d nil obj (entsel (strcat str (if (not (zerop undo)) "Отмени/" "")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if Multiple&nbsp;&nbsp;"оДин/" "Несколько/")&nbsp;&nbsp;"Выход]" (if Multiple&nbsp;&nbsp;" <готово>: " " <выход>: "))))
&nbsp;&nbsp;&nbsp;&nbsp;(cond ((= obj "Undo")(if (not (zerop undo))(progn (setq hyptxt "")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vl-cmdf "_UNDO" "_B")(setq undo (1- undo)))(alert "Нечего больше отменять")))
&nbsp;&nbsp;&nbsp;&nbsp;((= obj "Exit")(setq Flag nil d nil))((= obj "One")(setq hyptxt "" Multiple nil str "\nОдин-> Выберите текст ["))
&nbsp;&nbsp;&nbsp;&nbsp;((= obj "Multiple")(setq Multiple t hyptxt "" str "\nНесколько-> Выберите текст ["))&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;&nbsp;((null obj)(if Multiple (setq Flag t d t)(if (= (getvar "ERRNO") 52)(setq Flag nil)(princ " *** Мимо ***"))))
&nbsp;&nbsp;&nbsp;&nbsp;(t (setq ent (vlax-ename->vla-object (car obj)))
&nbsp;&nbsp;&nbsp;&nbsp; (cond ((= (vla-get-lock (vla-item lays (vla-get-layer ent))) :vlax-true)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(alert "На блокированном слое!"))
&nbsp;&nbsp;&nbsp;&nbsp; ((wcmatch (strcase(vla-get-ObjectName ent)) "*TEXT")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if Multiple (setq hyptxt (strcat hyptxt (VL-STRING-TRIM " " (mip_MTEXT_Unformat(vla-get-textstring ent))) " "))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq d t hyptxt (mip_MTEXT_Unformat(vla-get-textstring ent)))))
&nbsp;&nbsp;&nbsp;&nbsp; (t (alert "Объект не текст")))))(if d
&nbsp;&nbsp;&nbsp;&nbsp; (cond ((= (setq hyptxt (VL-STRING-TRIM " " hyptxt)) "")(princ "\n*Не введено значение заметки*"))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((setq sset (ssget "_:L"))(vl-cmdf "_UNDO" "_M")(setq undo (1+ undo))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(foreach item (vl-remove-if 'listp(mapcar 'cadr(ssnamex sset)))(eval (list note_func item hyptxt)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(setq hyptxt "")) (t nil))));while
 (vla-EndUndoMark adoc)(princ))
;|=============== Команда COOR ================================================
Экспорт координат указанных точек, выбранных объектов: точек, блоков, полилиний, сплайнов в текстовый файл, ексел.
Текстовый файл - либо txt, либо csv. Округление координат в соответствии с текущими настройками команды _UNITS|;
(defun c:COOR(/ cFile curPt filPath objSet oFlag oldMode ptLst sFlag lw isRus)
(defun group-by-num (lst num / ls ret)(if (= (rem (length lst) num ) 0)(progn (setq ls nil)
&nbsp;&nbsp;(repeat (/ (length lst) num)(repeat num (setq ls(cons (car lst) ls)lst (cdr lst)))
&nbsp;&nbsp;(setq ret (append ret (list (reverse ls))) ls nil)))) ret)
(defun PtCollect(SelSet)(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget
(vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))))); end of PtCollect
(defun PLCollect(SelSet / ret)
(foreach lw (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp(mapcar 'cadr(ssnamex SelSet))))
&nbsp;&nbsp;(cond ((wcmatch (vla-get-ObjectName lw) "*Polyline")
&nbsp;&nbsp;&nbsp;(setq ret (append ret (group-by-num (vlax-get lw 'Coordinates)
&nbsp;&nbsp;&nbsp;(if (=(vla-get-ObjectName lw) "AcDbPolyline") 2 3)))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((=(vla-get-ObjectName lw) "AcDbSpline")(setq ret (append ret (group-by-num
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vlax-safearray->list(vlax-variant-value (vla-get-controlpoints lw)))&nbsp;&nbsp;3))))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(t nil))) ret)
&nbsp;&nbsp;(vl-load-com)(setq isRus(= (getvar "SysCodePage") "ANSI_1251"))(if(not ptcol:mode)(setq ptcol:mode "Pick"))
&nbsp;&nbsp;(initget "Указать Точка Блоки Полилиния Pick pOints Blocks poLyline _Pick pOints Blocks poLyline Pick pOints Blocks poLyline")
(setq oldMode ptcol:mode ptcol:mode
(getkword (if IsRus (strcat "\nВыберите режим [Указать/Точка/Блоки/Полилиния или сплайн] <"
(cadr (assoc ptcol:mode '(("Pick" "Указать")("pOints" "Указать")("Blocks" "Блоки")("poLyline" "Полилиния")))) ">: ")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(strcat "\nSpecify mode [Pick/pOints/Blocks/poLyline or spline] <"ptcol:mode">: "))) ptLst nil)
(if(null ptcol:mode)(setq ptcol:mode oldMode))
(cond ((= "Pick" ptcol:mode)(setq curPt T)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (while curPt (setq curPt(getpoint (if IsRus
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "\nУкажите точку или Enter завершения > " "\nPick point or Enter to continue > ")))
&nbsp;&nbsp;&nbsp;(if curPt (setq ptLst(append ptLst(list (trans curPt 1 0))))))); end condition #1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((= "pOints" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "POINT")))))(progn
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if IsRus (princ "\nВыберите точки и нажмите Enter ")(princ "\nSelect points and press Enter "))
&nbsp;&nbsp;&nbsp; (setq objSet(ssget '((0 . "POINT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #2
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((= "Blocks" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "INSERT")))))(progn
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if IsRus(princ "\nВыберите блоки и нажмите Enter ")(princ "\nSelect blocks and press Enter "))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq objSet(ssget '((0 . "INSERT"))))))(if objSet (setq ptLst(PtCollect objSet)))); end condition #3
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;((= "poLyline" ptcol:mode)(if (not(setq objSet(ssget "_I" '((0 . "*POLYLINE,SPLINE")))))(progn
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if IsRus(princ "\nВыберите полилинии и нажмите Enter&nbsp;&nbsp;")(princ "\nSelect polyline and press Enter "))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq objSet(ssget '((0 . "*POLYLINE,SPLINE"))))))(if objSet (setq ptLst(PLCollect objSet)))); end condition #4
); end cond
(if ptLst (progn (princ "\n+++++++ Coordinates list +++++++\n")(setq ptLst (mapcar '(lambda(x)(trans x 0 1)) ptLst))
(mapcar '(lambda(x)(princ(strcat "\n"(rtos(car x))","(rtos(cadr x))
(if(= 3(length x))(strcat ","(rtos(nth 2 x))) "")))) ptLst); end mapcar
(princ "\n\n+++++++++ End of list +++++++++")(initget "Файл Excel Не Text Excel Not _Text Excel Not Text Excel Not")
(setq sFlag (getkword (if IsRus "\nСохранить координаты в [Файл/Excel/Не сохранять] <Файл> : "
"\nSave coordinates to [Text file/Excel/Not save] <Text> : ")))
(if(null sFlag)(setq sFlag "Text"))
(cond ((and (= "Text" sFlag)(setq filPath
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (getfiled (if IsRus "Сохранение координат в текстовый файл" "Save Coordinates to Text File") "Coordinates.txt" "txt;csv" 33)))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq cFile(open filPath "w"))(foreach ln ptLst (write-line (strcat (rtos(car ln))","(rtos(cadr ln))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if(= 3(length ln))(strcat ","(rtos(nth 2 ln))))) cFile))(close cFile)(initget "Yes No")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq oFlag(getkword (if IsRus "\nОткрыть файл? [Yes/No] <No> : " "\nOpen text file? [Yes/No] <No> : " )))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if(= oFlag "Yes")(startapp "notepad.exe" filPath))); end condition #1
&nbsp;&nbsp;&nbsp;&nbsp; ((= "Excel" sFlag)(xls (mapcar '(lambda(x)(mapcar 'rtos x)) ptLst) nil nil "COOR")); end condition #2
&nbsp;&nbsp;&nbsp;&nbsp; (t nil)))) (princ)); end of c:COOR
;|=============== Команда HYP ================================================
Заносит введенное описание объекта всем выбранным примитивам как гиперссылку
Включенеи/отключение показа гиперссылок см. команды
_HYPERLINKOPTIONS (ГИПЕРСВОЙСТВА)|;
(defun C:HYP ( / sset hyptxt)(vl-load-com)
(setq hyptxt (getstring t "\nОписание объекта <выход>: "))
(setq hyptxt (VL-STRING-TRIM " " hyptxt))
(if (and (/= hyptxt "")(setq sset (ssget "_:L")))
 (foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset))))
&nbsp;&nbsp; (mip-put-hyperlink item hyptxt)))(princ))
;|=============== Команда NOTE ================================================
Заносит введенное описание объекта всем выбранным примитивам как Notes|;
(defun C:NOTE ( / sset hyptxt)(vl-load-com)
(setq hyptxt (getstring t "\nОписание объекта <выход>: "))
(setq hyptxt (VL-STRING-TRIM " " hyptxt))
(if (and (/= hyptxt "")(setq sset (ssget "_:L")))
 (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))
&nbsp;&nbsp; (setnote item hyptxt)))(princ))
;|=============== Команда AREAS ================================================
Выводит Слой, Описание, площадь,длинну, цвет, гиперссылку в соответствующие столбцы Excel.
Скрытие показа глобуса гиперссылки см. команды _HYPERLINKOPTIONS (ГИПЕРСВОЙСТВА)|;
(defun c:AREAS (/ selset file_name&nbsp;&nbsp;*error* retLst lst i UrlDes are Notes)
(defun *error* (msg)(princ msg)(princ)) ;_ end of defun
(vl-load-com)
 (if (setq selset (ssget '((0 . "*POLYLINE"))))(progn (setq i 1)
&nbsp;&nbsp;(foreach item (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))))
&nbsp;&nbsp;&nbsp;&nbsp; (setq Notes (getnote item) i (1+ i) UrlDes "")
(if(not (zerop(vla-get-Count (vla-get-Hyperlinks item))))
&nbsp;&nbsp;(VL-CATCH-ALL-APPLY '(lambda()(setq UrlDes(vla-get-URLDescription(vla-item (vla-get-Hyperlinks item) 0))))))
&nbsp;&nbsp;&nbsp;&nbsp;(setq lst (list
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(strcat "'" (vla-get-layer item))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;|Слой"|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if (= Notes "") "" (strcat "'" Notes))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;|Notes полилинии|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(rtos(setq are(vla-get-area item)) 2 12)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;|Площадь полилинии|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(rtos(vla-get-Length item) 2 12)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;|Длина полилинии|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(vla-get-color item)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;;|Цвет полилинии|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(if (= UrlDes "") "" (strcat "'" UrlDes))&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ;|Гиперссылка|;
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;))
&nbsp;&nbsp;(setq retLst (append retLst (list lst))));_foreach
(xls retlst '("Слой" "Notes" "Площадь" "Длинна" "Цвет" "Гиперссылка") nil "AREAS")))
(princ))
;|=============== Команда T2N ================================================
Заносит значение текстовых объектов как Notes в вабранные объекты|;
(defun C:T2N ( )(add_note 'setnote))
;|=============== Команда T2HS ================================================
Заносит значение текстовых объектов как гиперссылку в вабранные объекты|;
(defun C:T2H ( )(add_note 'mip-put-hyperlink))
;;[url=https://www.caduser.ru/forum/topic19197.html]https://www.caduser.ru/forum/topic19197.html[/url]
;;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))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mapcar '(lambda(y)(cons lay y))(cadr x))) retlst))
(if (setq retlst (apply 'append retlst))(xls retlst '("Слой" "ТИП" "Длина") nil "SML")
(princ "\n ** Нет мультилиний **"))(princ))
;;Summ Block
;;[url=https://www.caduser.ru/forum/topic31669.html]https://www.caduser.ru/forum/topic31669.html[/url]
(defun c:SBLK (/ *error* retlst)
(defun *error* (msg)(princ msg)(princ)) ;_ end of defun
(vl-load-com)(setq retlst (Sum_Blk))
(setq retlst(mapcar '(lambda(x / lay)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq lay (car x))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (mapcar '(lambda(y)(cons lay y))
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (cadr x))) retlst))
(if (setq retlst (apply 'append retlst))
(xls retlst '("Слой" "Имя" "Количество") nil "SBLK")
(princ "\n ** Нет блоков **"))(princ))
(princ "\nНаберите в командной строке:")
(princ "\n\tSML - сумма мультилиний")
(princ "\n\tSBLK - сумма блоков")
(princ "\n\tT2H - текст в гиперссылку")
(princ "\n\tT2N - текст в Notes (ADT)")
(princ "\n\tAREAS - площади полилиний")
(princ "\n\tHYP - задать гиперссылку объектам")
(princ "\n\tNote - задать Notes объектам")
(princ "\n\tCOOR - экспорт координат")

Прилепить вот этот:


(if (car (atoms-family 1 '("vl-load-com"))) (vl-load-com))
(defun order_error (s)
(if txt (vla-delete txt))
(setq *error* old_error)
(setvar "CLAYER" old_sloy)
)
(defun mSpace (/ doc mSp)
(setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if (= 1 (getvar "TILEMODE"))
(setq mSp (vla-get-ModelSpace doc))
(setq mSp (vla-get-PaperSpace doc)))
)
(defun oFind (/ selfnd n fTxt count lst lstmax)
(setq selfnd (ssget "X" (list (cons '8 '"order")(cons '0 '"TEXT"))) n 0 lstmax 0)
(if (/= selfnd nil)(setq count (sslength selfnd))(setq count 0))
(while (< n count)
(setq fTxt (vlax-ename->vla-object (ssname selfnd n)))
(setq lst (atoi(vla-get-textstring fTxt)) n (1+ n))
(if (< lstmax lst)(setq lstmax lst)))
(setq lstmax (1+ lstmax))
)
(defun oReplace (rTXT rNUM / sel)
(while (> (sslength (setq sel (ssget "X" (list (cons '8 '"order")(cons '0 '"TEXT")(cons '1 (itoa rNUM)))))) 1)
(progn
(setq sel (ssdel (vlax-vla-object->ename rTXT) sel))
(setq rTxt (vlax-ename->vla-object (ssname sel 0)))
(vla-put-textstring rTxt (itoa (setq rNum (1+ rNum))))))
)
(defun c:order (/ ht begin flg pick lt pt)
(setq ht 3 old_error *error* *error* order_error old_sloy (getvar "CLAYER") num (oFind))
(if (not (cdadr (tblsearch "LAYER" "order")))
(vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-Acad-Object))) "order"))
(setvar "CLAYER" "order")
(if (setq begin (getint (strcat "\nНачальный номер <" (itoa num) ">:")))(setq num begin))
(while (/= flg t)
(princ (strcat "\nУкажите местоположение номера [" (itoa num) "]:"))
(setq txt (vla-addtext (mSpace) (itoa num) (vlax-3d-point '(0 0 0)) ht))
(while (/= pick t)
(setq pt (cadr (setq lt (grread t))))
(if (and pt (listp pt))
(progn
(if (= (car lt) 5)(vla-put-insertionPoint txt (vlax-3d-point pt)))
(setq pick (= 3 (car lt))))
(progn (vla-delete txt)(setq flg t txt nil))))
(progn (oReplace txt num)(setq num (1+ num) pick nil)))
(setq *error* old_error)
(setvar "CLAYER" old_sloy)
)


Суть второго заключается в том что он проставляет номер в формате текста в указанной точке.
Можно ли соединить их  и сделать доработанный аналог функции t2n, чтоб проставляемый текст сразу присваивался объекту в качестве текста?