• Random
  • Активный участник
  • На форуме с 14 апреля 2004г.
  • Сообщений: 154
  • Спасибо: 0

Тема: LISP. Подсчет длины линий на определенном слое

Примечание:
1. Учитываются примитивы только типа LINE
2. Макрос для кнопки будет работать только если сохранить код в файле Calc_dist.lsp и поместить этот файл по одному из путей поиска акада (например в папку Support)

(defun calc_dist (
          /
          lines
          layer
          index
          sum
          obj
         )
  (vl-load-com)
  (setq sum 0)
  (setq index 0)
  (setq layer (assoc 8 (entget (car (entsel "\nSelect layer object:")))))
  (setq lines (ssget "_x" (list '(0 . "LINE") layer)))
  (repeat (sslength lines)
    (setq obj (vlax-ename->vla-object (ssname lines index)))
    (setq sum (+ sum (distance (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj))))
    (setq index (1+ index))
  )
  (princ (strcat "\nLength - " (rtos sum)))
  (princ)
)

Макрос для кнопки
^C^C^P(if (not (calc_dist)) (load "calc_dist.lsp")) (calc_dist)

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: LISP. Подсчет длины линий на определенном слое

Может так лучше?

(defun calc_dist (/ sset)
(vl-load-com)
(if (setq
sset (ssget "_x"
(list '(0 . "LINE")
(assoc 8 (entget (car (entsel "\nSelect layer object:")))))))
(princ (strcat "\nLength - "
(rtos(apply (function +)
(mapcar (function
(lambda (e) (vla-get-Length (vlax-ename->vla-object e))))
(vl-remove-if (function listp)
(mapcar (function cadr) (ssnamex sset))))))))))

  • kos
  • Восстановленный участник
  • На форуме с 6 марта 2002г.
  • Сообщений: 637
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Вот еще ссылка на эту тему...
http://dwg.ru/forum/viewtopic.php?t=953&highlight=
______________
Удачи.

  • Djek
  • Восстановленный участник
  • На форуме с 17 марта 2004г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

А так вроди бы ещё интереснее

(defun C:Dlina (/ Nab Sum i Curve Param)
(vl-load-com)
(if (setq Nab (ssget))
(progn
(setq Sum 0 i 0)
(repeat (sslength Nab)
(setq Curve (vlax-ename->vla-object (ssname Nab i))
i (1+ i)
Param (vl-catch-all-apply 'vlax-curve-getEndParam
(list Curve))
)
(if (not (vl-catch-all-error-p Param))
(setq Sum (+ Sum (vlax-curve-getDistAtParam Curve
Param)))
)
)
)
)
(princ (strcat "\nСумма длин выбранных элементов равна: " (rtos Sum 2 2)))
(prin1)
)

  • Sanek
  • Восстановленный участник
  • На форуме с 10 ноября 2005г.
  • Сообщений: 100
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

(defun C:l_l();Функция расчёта длины примитивов типа LINE в слое КВВГ4х1
(setq xy6 (ssget "X" '((8 . "КВВГ4х1"))))
(setq sum_l 0)
(setq q(sslength xy6))
;проверка колиства примитивов
  (while (> q 0)
   (setq xy5 (ssname xy6 (- q 1)))
   (setq xy4 (entget xy5))
   (setq xy3(assoc 10 xy4))
   (setq xy2(assoc 11 xy4))
;расчёт длинны примитива параллельного оси х   
   (setq xy1(cdr xy3))
   (setq xy0(cdr xy2))
   (setq x1(car xy1))
   (setq x2(car xy0))
   (setq хdelta(abs(- x2 x1)))
;расчёт длинны примитива параллельного оси y
   (setq xy1(cddr xy3))
   (setq xy0(cddr xy2))
   (setq y1(car xy1))
   (setq y2(car xy0))
   (setq ydelta(abs(- y2 y1)))   
;расчёт длинны примитива не параллельного осям xy
   (setq xtemp(expt хdelta 2))
   (setq ytemp(expt ydelta 2))
   (setq sum(+ xtemp ytemp))
   (setq cool(sqrt sum))
   (setq sum_l(+ cool sum_l))
;проверка колиства примитивов
  (setq q(- q 1)))
(print sum_l)
  )

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

А можете сделать с запросом слоя?
Чтобы длина всех 3D-полилиний, полилиний и линии относящиеся к слою, выбранному из списка, умножалась на коэфициет задаваемый при запросе.
Заранее спасибо.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

Пробуй, тестируй

(defun c:mlen (/ adoc selset layer_list init _kpblc-string-subst item sum_len)
  (defun _kpblc-string-subst (string old-substr new-substr)
    (if    (vl-string-search old-substr string)
      (progn
    (setq string (vl-string-subst new-substr old-substr string))
    (_kpblc-string-subst string old-substr new-substr)
    ) ;_ end of progn
      string
      ) ;_ end of if
    ) ;_ end of defun
  (vl-load-com)
  (setq    adoc    (vla-get-activedocument (vlax-get-acad-object))
    sum_len    0.0
    ) ;_ end of setq
  (vla-startundomark adoc)
  (vlax-for item (vla-get-layers adoc)
    (setq layer_list (append layer_list (list item)))
    ) ;_ end of vlax-for
  (foreach item    layer_list
    (setq init (strcat (if (not init)
             ""
             init
             ) ;_ end of if
               (vla-get-name item)
               " "
               ) ;_ end of strcat
      ) ;_ end of setq
    ) ;_ end of foreach
  (initget (vl-string-trim " " init))
  (if (not (setq answer    (getkword (strcat "\nSelect layer ["
                      (_kpblc-string-subst init " " "/")
                      "] <All> : "
                      ) ;_ end of strcat
                  ) ;_ end of getkword
         ) ;_ end of setq
       ) ;_ end of not
    (setq selset (ssget))
    (setq selset (ssget (list (cons 8 answer))))
    ) ;_ end of if
  (while (and selset
          (> (sslength selset) 0)
          ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (setq item      (vlax-ename->vla-object item)
      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)
             ) ;_ end of cond
               ) ;_ end of if
             ) ;_ end of +
      ) ;_ end of setq
    ) ;_ end of while
  (princ (rtos sum_len 2 4))
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

?
не понял как выбирать слой, в котором надо "сосчитать кабель"
Вижу вот что:
Select layer
[0/IAAAEU/_EAIAIOU__A_IIAEEA/RASMER1/_EAIAIOU__NEECA/_E_IAEY_2/_/Текст/Экспликац
ия/помещений/IIE_UOEY/Маркировка/дверей/_EICU_AE3/_AENOU/Маркировка/окон/_A_OAE_
_NEECIUE/AIOO_AE/IA_AE_UOEY/IA_OEIUA_NOAIU/Размеры/выноски/Планировка/Воздух/Вод
а/Надписи/кабельный/трассы/Электротехн./оборудование/Груповая/сеть/Непечатаемый/
Вопросы/3х1.5/Defpoints/1/Экспликация/Вытяжка/] <All> :
и не могу понять как ввести слой.
Пишу ему название слоя, а он (AutoCad) мне вон что выдает:
Неправильное ключевое слово.

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Крыс!
мне вот к примеру чтобы выблать слой 3х1.5
что надо ввести

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

По правой кнопке в выпадающем меню. Или тебе по-другому надо? то бишь кликнул на объекте, взял с него слой и по этому слою выбор делать?

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

Вот это вообще не проверял (в отличие от предыдущего варианта):

(defun c:mlen2 (/ adoc selset layer_list init _kpblc-string-subst item sum_len)
  (vl-load-com)
  (setq    adoc    (vla-get-activedocument (vlax-get-acad-object))
    sum_len    0.0
    ) ;_ end of setq
  (vla-startundomark adoc)
  (if
    (setq ent (entsel "\nУкажите примитив, с которого брать слой <Выход> : "))
     (progn
       (setq selset (ssget (list (assoc 8 (entget (car ent))))))
       (while (and selset
           (> (sslength selset) 0)
           ) ;_ end of and
     (setq item (ssname selset 0))
     (ssdel item selset)
     (setq item    (vlax-ename->vla-object item)
           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)
                  ) ;_ end of cond
                ) ;_ end of if
              ) ;_ end of +
           ) ;_ end of setq
     ) ;_ end of while
       (princ (rtos sum_len 2 4))
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Хочется чтобы сначала выбор слоя, а потом коэфициент умноэжения и все
длина всех линий этого слоя умноженная на коэфициент готова

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

Блин, еще и коэффициент... Давай так - ты сначала проверь работоспособность, добивать потом будем, ок?

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

ок

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

работает
и скорее всего работает именно так как ты планировал
но выбирать приходится одну из линий нужного слоя, а для этого ее надо найти.
Лучше слой выбирать из выпадающего меню
(а то слои слои имеют одинаковые настройки, а линии часто наложены одна на другую)

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

а еще лучше, если выбираешь несколько слоев
и ответ получаешь отдельно типа:
"название слоя" - столько
"название следующего слоя" - слолько
и т.д.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

Ну дык ета... Сэр, скажите, чего надобно :) - Вариантов масса.
1. Написать специальное приложение (arx, dll или еще чего), которое позволит выбрать сразу несколько элементов из списка слоев.
2. Вручную поотключать ненужные слои.
3. Перед макросом вызова поставить *
4. Все равно работать на всех слоях, но в ком.строку выводить нечто типа:
Слой1 : Общая длина = 15456,3265
Слой2 : Общая длина = 6565989832,65659898
==
Так чего надобно-то?

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Первое, то которое позволит несколько слоев из списка выбрать, а ответ в виде
Слой1 : Общая длина = 15456,3265
Слой2 : Общая длина = 6565989832,65659898

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: LISP. Подсчет длины линий на определенном слое

Не, я на такое не способен :(

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: LISP. Подсчет длины линий на определенном слое

> Pave1
По моему проще сделать подсчет по всем слоям...
Пользователь сам выберет нужные smile

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Ладно
и за предыдущие спасибо
Буду значит mlen2 пользоваться.
Еще раз спасибо. Я вашими лиспами Крыс! с удовольствием пользуюсь. Они отличные помошники при проектировании!

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Евгений Елпанов
а что? у вас есть такой лисп?
:) А всяко есть :)
выложите пожалуйста

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: LISP. Подсчет длины линий на определенном слое

> Pave1
Нету такого - небыло необходимости...
Сделал предложение считать по всем слоям - на мой взгляд, функция подсчета становится гагаздо проще, чем ваши предложения по выбору и фильтрации слоев и.т.д...

  • Откуда: Москва
  • На форуме с 2 июля 2004г.
  • Сообщений: 2,538
  • Спасибо: 10

Re: LISP. Подсчет длины линий на определенном слое

Вот набросал по быстрому...
Немного переделал функцию kpblc, причем без спросу.
>kpblc Заранее извиняюсь, что переделал твою задумку на свой лад.

(defun c:mlen3 ()
  (vl-load-com)
  (princ "\n  Общая длинна всех линейных примитивов по слоям:")
  (mlen3_1 t)
  (princ)
) ;_  defun
(defun mlen3_1 (i)
  (if (setq i (tblnext "LAYER" i))
    (progn
      (mlen3_2 (cdadr i))
      (mlen3_1 nil)
    ) ;_  cons
  ) ;_  if
) ;_  defun
(defun mlen3_2 (lay / SS SUM_LEN)
  (if (setq
    sum_len    0.
    ss    (ssget "_X" (list (cons 8 lay)))
      ) ;_  setq
    (foreach item (mapcar
            (function vlax-ename->vla-object)
            (vl-remove-if
              (function listp)
              (mapcar
            (function cadr)
            (ssnamex ss)
              ) ;_  mapcar
            ) ;_ vl-remove-if
          ) ;_  mapcar
      (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
        ) ;_  +
      ) ;_  setq
    ) ;_  foreach
  ) ;_  if
  (princ (strcat "\n\t" lay " = " (rtos sum_len 2 4)))
) ;_  defun

  • Pave1
  • Восстановленный участник
  • На форуме с 25 апреля 2006г.
  • Сообщений: 18
  • Спасибо: 0

Re: LISP. Подсчет длины линий на определенном слое

Евгений Елпанов
отлично. Все супер, считать кабель стало гораздо легче :)
Спасибо