| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

Нужен LISP для суммы длин отрезков линни

Ответ
Поиск в этой теме
Непрочитано 26.02.2004, 10:13
Нужен LISP для суммы длин отрезков линни
ilka_t
 
Москва
Регистрация: 20.01.2004
Сообщений: 154

Подскажити где можно скачать или поделитись если у кого есть такое.

Полилиния не подходит т.к. эти отрезки разбросаны по всему чертежу, а надобы выбрав несколько линий узнать их общую длинну.
Просмотров: 140321
 
Непрочитано 11.12.2009, 10:19
#141
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Цитата:
Сообщение от Shish Посмотреть сообщение
Команда: (eval vlax-ename->vla-object)
nil
Самое быстрое и простое решение в данном случае - переустановка автокада...
__________________
Чем гениальнее ваш план, тем меньше людей с ним будут согласны.
/Сунь Цзы/
Елпанов Евгений вне форума  
 
Непрочитано 11.12.2009, 10:39
#142
Shish

Руководитель проектной организации
 
Регистрация: 15.09.2009
Москва
Сообщений: 90


Блин, плохо... Кнопочки, цвета, крестики, все ж опять настраивать... Можно все настройки каким-нибудь одним файлом сохранить? Понимаю, что можно и F1 нажать, но... лень.

Жень, спасибо за помощь! Переустановил, все работает. Рабочее пространство сохранил мастером переноса пользовательских настроек.

Последний раз редактировалось Shish, 11.12.2009 в 13:32.
Shish вне форума  
 
Непрочитано 13.01.2010, 17:01
#143
Aндрeй


 
Регистрация: 23.08.2007
Москва
Сообщений: 529


Как все-таки коэффициент менять, только в коде?
мм не работает...
Aндрeй вне форума  
 
Непрочитано 16.01.2010, 15:51
#144
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Андрей, нельзя ли подробнее вопрос поставить?
skkkk вне форума  
 
Непрочитано 24.01.2010, 20:23
#145
Aндрeй


 
Регистрация: 23.08.2007
Москва
Сообщений: 529


Цитата:
Сообщение от skkkk Посмотреть сообщение
Андрей, нельзя ли подробнее вопрос поставить?
Как задается масштаб?
Только в коде, изменением *MIP-MODEMACRO-SCALE*?
Либо есть еще какие-то варианты после запуска?
Aндрeй вне форума  
 
Непрочитано 25.01.2010, 10:23
#146
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Aндрeй Посмотреть сообщение
Как задается масштаб?
Только в коде, изменением *MIP-MODEMACRO-SCALE*?
Либо есть еще какие-то варианты после запуска?
Есть. Уточни, из какого поста скопировал код? В #104 есть команды
Цитата:
(princ "\nНаберите в командной строке:
\nEntLen - подсчет примитивов
\nMM - масштабный коэффициент и настройка
\nLPN - результат в новый текст
\nLPE - результат в существующий текст")
В принципе можно докопировать команду к своему коду.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.01.2010, 10:25
#147
ktstar


 
Регистрация: 25.07.2007
ПОЛТАВА
Сообщений: 7


Установите Веткад... Там есть "суперкалькулятор". У него есть функция суммирование длин линий, дуг, окружностей, разбросанных по всему чертежу.... У меня стоит версия 3.3
ktstar вне форума  
 
Непрочитано 29.12.2010, 12:44
#148
DiF


 
Регистрация: 03.10.2010
Сообщений: 31


Добрый день! Подскажите пожалуйста.
Есть чертеж, схема сети, на ней разными слоями нанесены емкости кабелей.
Необходимо сосчитать их суммарную длину и умножить на некий коэффициент, который соответствует реальному расстоянию.

Можно это как то сделать автоматически?

На первой взяд lips, он отлично считает выбеленные отрезки, но может быть как-то можно выделить сразу все отрезки одного слоя на модели?
Спасибо большое!
DiF вне форума  
 
Непрочитано 29.12.2010, 12:55
#149
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,985


Цитата:
Сообщение от DiF Посмотреть сообщение
может быть как-то можно выделить сразу все отрезки одного слоя на модели
(ssget "_x" '((0 . "LINE") (410 . "Model") (8 . Имя слоя")))
Nike вне форума  
 
Непрочитано 29.12.2010, 13:17
#150
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от DiF Посмотреть сообщение
Есть чертеж, схема сети, на ней разными слоями нанесены емкости кабелей.
Необходимо сосчитать их суммарную длину и умножить на некий коэффициент, который соответствует реальному расстоянию.
Команда MLEN41
Остальные варианты LISP. Подсчет длины линий на определенном слое
Код:
[Выделить все]
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=44&TID=20298&PAGEN_1=3
;|================== XLS ========================================
* Опубликовано http://www.caduser.ru/forum/index.php...&TID=19920
               http://www.caduser.ru/forum/index.php...&TID=31444
               http://www.caduser.ru/forum/index.php...&TID=31669
* Автор: Владимир Азарко aka VVA
* Назначение: Печать списка данных Data-list в Excell
*             Для вывода создается новый лист
* Аргументы:
              Data-list — список списков данных (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 ( Data-list 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)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))
(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 Data-list)(setq iz_listo (car Data-list))(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 Data-list (cdr Data-list))(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))
;_Команда MLEN41
(defun c:mlen41 (/ m ss clist temp)
  (defun sort (lst predicate)
    (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
  )
  (defun combine (inlist is-greater is-equal / sorted current result)
    (setq sorted (sort inlist is-greater))
    (setq current (list (car sorted)))
    (foreach item (cdr sorted)
      (if (apply is-equal (list item (car current)))
  (setq current (cons item current))
  (progn
    (setq result (cons current result))
    (setq current (list item))
  )
      )
    )
    (cons current result)
  )
  (defun mlen4_1 (lst / sum_len)
    (setq sum_len 0)
    (foreach item (mapcar 'car lst)
      (setq
  sum_len  (+ sum_len
       (if (vlax-property-available-p item 'length)
         (vla-get-length item)
         (cond
           ((=
        (strcase (vla-get-objectname item) t)
        "acdbarc"
      ) ;_  =
      (vla-get-arclength item)
           )
           ((=
        (strcase (vla-get-objectname item) t)
        "acbcircle"
      ) ;_  =
      (* pi 2.0 (vla-get-radius item))
           )
           (t 0.0)
         ) ;_  cond
       ) ;_  if
    ) ;_  +
      )
    )
    (if  (not (zerop sum_len))
      (princ
  (strcat "\n\t" (cdar lst) " = " (rtos (* sum_len m) 2 4))
      )
    )
    (list (cdar lst)(rtos (* sum_len m) 2 4))
  )
  (vl-load-com)
  (if (null *M*)(setq *M* 1))
  (initget 6)
  (and
    (princ "\nВведите маштабный коэффициент <")
    (princ *M*)(princ ">: ")
    (or (setq m (getreal))
   (setq m *M*)
   )
    (setq *M* m)
    (setq ss (ssget "_:L"))
    (setq ss (mapcar
         (function vlax-ename->vla-object)
         (vl-remove-if
     (function listp)
     (mapcar
       (function cadr)
       (ssnamex ss)
     ) ;_  mapcar
         ) ;_ vl-remove-if
       )
    )
    (mapcar '(lambda (x)
         (setq temp (cons (cons x (vla-get-Layer x)) temp))
       )
      ss
    )
    (setq clist  (combine temp
       '(lambda (a b)
          (> (cdr a) (cdr b))
        )
       '(lambda (a b)
          (eq (cdr a) (cdr b))
        )
    )
    )
    (princ
      "\n\n  Общая длинна всех линейных примитивов по слоям:"
    )
    (setq temp (mapcar 'mlen4_1 clist))
    (xls temp '("Слой" "Длина") nil "mlen41")
  )
  (princ)
) ;_  defun
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 29.12.2010, 14:00
#151
DiF


 
Регистрация: 03.10.2010
Сообщений: 31


Спасибо. Спасибо огромное. =)
DiF вне форума  
 
Непрочитано 24.06.2011, 22:03 (LISP) Подсчет отрезков по слоям и вывод в XLS файл.., Помогите пожалуйста.
#152
AutoS


 
Регистрация: 24.06.2011
Сообщений: 4


Всем привет.
Нужна программа на LISP, которая будет подсчитывать количество примитивов в каждом слое и потом записывать все это в XLS файл.
Заранее Большое Спасибо.
AutoS вне форума  
 
Непрочитано 24.06.2011, 22:07
#153
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


_.qselect, выписать на бумажку, вбить в ексль.
Большое Пожалста.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 24.06.2011, 22:16
#154
AutoS


 
Регистрация: 24.06.2011
Сообщений: 4


Спасибо.
Это вроде как не подходит..
Например если имеется 100+ слоев..
Нужна программка которая пере клацает все слои и впишет количество примитивов под именем каждого слоя в XLS файл..
Спасибо еще раз..
AutoS вне форума  
 
Непрочитано 24.06.2011, 22:27
#155
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,772


Есть пара встречных вопросов:
1. А как быть с примитивами, которые находятся внутри блоков или внешних ссылок?
2. Что сделано самостоятельно и на чем спотык?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 24.06.2011, 22:38
#156
AutoS


 
Регистрация: 24.06.2011
Сообщений: 4


1- В блоках считать, в ссылках- нет (про ссылки не понял).
2- Недавний юзер AutoCAD и только только начинаю учить LISP.
В таких закидонах не силен, и потому и спрашиваю у профессионалов..
AutoS вне форума  
 
Непрочитано 24.06.2011, 23:40
#157
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,985


AutoS, нафига тебе лисп? Запусти "Извлечение данных" и сортируй по любому параметру,
Nike вне форума  
 
Непрочитано 24.06.2011, 23:50
#158
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


AutoS, Команду MLEN41 из #150 смотрел?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.06.2011, 16:51
#159
AutoS


 
Регистрация: 24.06.2011
Сообщений: 4


VVA, смотрел, работает классно, вот только количества для каждого слоя там нет..
Было Бы очень хорошо, чтобы после столбца со слоями шел столбец с количеством, а потом длинна..
В любом случае Большое Вам Спасибо.
AutoS вне форума  
 
Непрочитано 16.01.2012, 11:33
#160
dew


 
Регистрация: 30.12.2007
Сообщений: 23


ребята а можно переделать данный код чтобы результат можно было бы вставить в таблицу (в нужную ячейку) на чертеже

Код:
[Выделить все]
(setq *MIP-MODEMACRO-RTOS* 2)      ;_Округление до 2-х знаков
(setq *MIP-MODEMACRO-SCALE* 0.1) ;_Масштаб 
(setq *MIP-MODEMACRO-HTXT* 2.5) ;_Высота текста

(vl-load-com)
(if (null *MIP-MODEMACRO-HTXT*)(setq *MIP-MODEMACRO-HTXT* 3.0)) ;_Высота текста
(if (null *MIP-MODEMACRO-RTOS*)(setq *MIP-MODEMACRO-RTOS* -1.0));_Округление -1-LUPREC
(if (null *MIP-MODEMACRO-SCALE*)(setq *MIP-MODEMACRO-SCALE* 1)) ;_Масштаб
(VL-PROPAGATE '*MIP-MODEMACRO-HTXT*)
(VL-PROPAGATE '*MIP-MODEMACRO-RTOS*)
(VL-PROPAGATE '*MIP-MODEMACRO-SCALE*)
(defun C:entLen1 (/ set:entities      int:allEntities 
            int:curveEntities int:l        rea:length 
        )
  (princ "\nТекущий коэффициент K=")(princ (VL-PRINC-TO-STRING *MIP-MODEMACRO-SCALE*))
  (if (not (setq set:entities (cadr (ssgetfirst))))    ; Этот if добавлен для 
    (setq set:entities (ssget "_:E:S"))            ; обработки предварительного 
  ) ;_ if                  ; выбора примитивов 
  (if set:entities 
    (progn 
      (setq int:allEntities 
        (sslength set:entities)  ; количество выбранных примитивов 
      int:curveEntities 
        0            ; счетчик линейных примитивов 
      int:l 0        ; счетчик 
      rea:length 
        0.0        ; общая длина линейных примитивов 
      ) ;_  setq 
      (while (< int:l (sslength set:entities)) 
  (if 
    (not 
      (vl-catch-all-error-p 
        (vl-catch-all-apply 
      'vlax-curve-getStartPoint 
      (list 
        (vlax-ename->vla-object (ssname set:entities int:l)) 
      ) ;_ list 
        ) ;_  vl-catch-all-apply 
      ) ;_  vl-catch-all-error-p 
    ) ;_  not 
      (setq int:curveEntities (1+ int:curveEntities) 
      rea:length      (+ rea:length 
                  (vlax-curve-getDistAtParam 
              (vlax-ename->vla-object 
                (ssname set:entities int:l) 
              ) ;_ vlax-ename->vla-object 
              (vlax-curve-getEndParam 
                (ssname set:entities int:l) 
              ) ;_ vlax-curve-getEndParam 
                  ) ;_  vlax-curve-getDistAtParam 
              ) ;_  + 
      ) ;_  setq 
  ) ;_  if 
  (setq int:l (1+ int:l)) 
      ) ;_  while
      (setq *MIP-LENGTH* (* *MIP-MODEMACRO-SCALE* rea:length))
      (princ (strcat "\n Выбрано примитивов: " 
          (itoa int:allEntities) 
          ", из них линейных: " 
          (itoa int:curveEntities)
          "\nПоправочный коэфиициент K="                    
          "\n Общая длина линейных примитивов: "
        (rtos *MIP-LENGTH* 2 (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*))                    
        ) ;_ strcat 
      ) ;_ princ 
    ) ;_  progn 
    (alert "Примитивы не выбраны!") 
  ) ;_  if 
  (prin1) 
(defun TTC_Paste(pasteStr keepText / nslLst vlaObj)
(if (setq nslLst(nentsel "\nТекст, атрибут, таблица или размер для вставки <выход>: "))
(progn (cond
((and (= 4(length nslLst))
 (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object (cdr(assoc -1(entget(car(last nslLst)))))))
(setq oldStat (vla-get-Measurement vlaObj))
(if keepText
 (if (= (vla-get-TextOverride vlaObj) "")
 (setq pasteStr (strcat pasteStr (rtos oldStat (vla-get-UnitsFormat vlaObj) (vla-get-PrimaryUnitsPrecision vlaObj))))
 (setq pasteStr (strcat pasteStr (vla-get-TextOverride vlaObj)))))
(if (vl-catch-all-error-p(vl-catch-all-apply 'vla-put-TextOverride(list vlaObj pasteStr)))
 (princ "\n Can't paste. Object may be on locked layer. "))); end condition #1
((and (= 4(length nslLst))
(= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString(list vlaObj pasteStr)))
(princ "\nError. Can't pase text. ")(entupd (car(last nslLst))))); end condition # 2
((and (= 4(length nslLst))
 (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))); end and
(princ "\nCan't paste to block's DText or MText. ")); end condition #3
((and (= 2(length nslLst))
(member(cdr(assoc 0(entget(car nslLst)))) '("TEXT" "MTEXT" "ATTRIB" "ATTDEF"))); end and
(setq vlaObj (vlax-ename->vla-object(car nslLst)))
(if keepText (setq pasteStr (strcat pasteStr (vla-get-TextString vlaobj))))
(if (vl-catch-all-error-p
      (vl-catch-all-apply
        '(lambda()
          (vla-put-TextString vlaObj pasteStr)
          (vla-put-Color vlaObj 3)  ;3-номер цвета
          )
        )
      )
(princ "\nError. Can't pase text. "))); end condition #4
(T (princ "\nCan't paste. Invalid object. ")); end condition #5
); end cond
T); end progn
nil); end if
);_TTC_PASTE
(and (= (type *MIP-LENGTH*) 'REAL)
(TTC_Paste (vl-string-translate "." "."  (rtos *MIP-LENGTH* 2
            (if (< *MIP-MODEMACRO-RTOS* 0)(getvar "LUPREC") *MIP-MODEMACRO-RTOS*)))
 nil))
(princ))

Последний раз редактировалось Кулик Алексей aka kpblc, 16.01.2012 в 11:44.
dew вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужен LISP для суммы длин отрезков линни

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск