Тема: Как узнать длину мультилинии?
длина мультилинии или нескольких ?
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → Как узнать длину мультилинии?
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Предполагаю, что для начала надо из списка объекта "MLINE" вытащить элементы с кодом 11 в новый список, а дальше уже просто.
КАК ВЫТАЩИТЬ?
> Владимир Громов
>Владимир Громов (2005-07-17 09:39:15а как вытащить? ответте пожалуйста на azsx4@mail.ru
> alb
Да я еще не определился, как вытащить, некогда. Поэтому, в сущности, и отвечать нечего.
> alb
Спробуй так больше от жары ничего в голову не лезет:
(defun mlen (/ mline_entity mline_length vertex_list)
(setq mline_entity
(car (entsel "\nВыбрать мультилинию\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)))))
;TesT:(mlen)
~'O'~
> Олег(jr.)
Хорошая программа. Я имел наглость немного доработать ее для alb:
;********* 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
> Владимир Громов
И весьма уместно,
спасибо
~'O'~
если можно то поподробнее !!! как все это применить у меня автокад русифицированный частично заранее весьма благодарен!
> alb
Как применить.
I. Создание файла
1. Выделяешь все строки кода и копируешь в буфер обмена (можно по правой кнопке мыши).
2. Запускаешь Блокнот и вставляешь код в документ.
3. Выполняешь команду "Сохранить как...". Для типа файла надо выбрать "Все файлы". Файл сохраняешь под именем mlen.lsp в папке "Support" AutoCAD'а (найдешь его в папке "Program Files"). Это самый простой способ.
II. Создание кнопки.
Описание этой процедуры посложней, а времени сейчас в обрез. Может, попозже. Сама-то процедура достаточно проста.
> Владимир Громов
Большое спасибо я живу в Калининграде так-что если нужна какя-либо помощь то обращайтесь !
Продолжаю инвентаризацию...
Помогите сделать спецификацию ВЫБРАННЫХ мультилиний вида:
Слой-Тип мультилинии-Сумма длинн мультилиний такого типа на слое.
Все это в текстовое окно или xls файл.
;|================== 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 в командной строке")
В ф-ции xls, исправлена одна неточность c Autofit столбцов, поэтому можешь использовать ее вместо https://www.caduser.ru/forum/topic31669.html VVA (2006-12-01 18:23:25)
to VVA
Вид таблицы 100% подходящий!
Однако на мой взгляд, более универсально будет если SML будет считать ВЫДЕЛЕННЫЕ (активированные) мультилинии, т.к. приходится подсчитывать набор линий (десятка два-три :)), кроме того, в расчет попадают ненужные зарисовки на полях чертежа ;)
Найди в коде строку
(if (setq ss (ssget "_X" (list (cons 0 "MLINE"))))
и попробуй заменить на
(if (setq ss (ssget (list (cons 0 "MLINE"))))
to kpblc
Просто колдун! ;)
Насчет установки Notes - глухо? :(
Да нет, просто работы слишком много, не вздохнуть. Там же думать надо :)
> VVA
Тут одни мерзавцы шлют неплохие чертежи. У них мультилинии (воздуховоды) отличаются Scale. Нельзя ли в SML к ("Слой" "ТИП" "Длина") добавить "Scale"?
> iv
У меня поменялись версии ф-ций, поэтому привожу их все
;|================== 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 в командной строке")
Соответственно SML - старый
SML1 - новый
Не знаю,жива ли тема.А можно еще добавить-группировать длина/количество.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → Как узнать длину мультилинии?
Форум работает на PunBB, при поддержке Informer Technologies, Inc