Тема: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

; Программка рассчитывает длину трассы, состоящей из
; отрезков и дуг. Трасса может иметь разветвления. В
; качестве параметра указывается точность сочленения
; элементов трассы.
; Возвращает длину трассы и количество элементов.
; Подъсвечивает обсчитанную трассу. Можно также
; использовать для поиска неточности соединения элементов
; трассы.
; Автор: Борис Глумов
(defun trassa(tch / prim1 dl)
  (setvar"cmdecho"0)(command"_regen")(setvar"cmdecho"1)
  (while(not(setq prim1(car(entsel"Укажите любой элемент трассы: \n")))))
  (if(raschkoord prim1 0)
    (progn
      (setvar"cmdecho"0)(command"_ZOOM""_E")
      (setq dl(dlina(append(uzel prim1(raschkoord prim1 0)tch)(cdr(uzel prim1(raschkoord prim1 1)tch)))))
      (command"_ZOOM""_P")(setvar"cmdecho"1)
      dl
    )
    (progn(princ"Это не отрезок и не дуга!")(princ))
  )
)
(defun raschkoord(prim1 p / tipprim)
  (setq tipprim(cdr(assoc 0(entget prim1))))
  (cond
    ((= tipprim"LINE")(cdr(assoc(+ 10 p)(entget prim1))))
    ((= tipprim"ARC")
      (polar(cdr(assoc 10(entget prim1)))(cdr(assoc(+ 50 p)(entget prim1)))(cdr(assoc 40(entget prim1))))
    )
  )
)
(defun memb(mb sp1 / ind)
  (foreach p sp1
    (if(eq mb(car p))(setq ind T))
  )
  ind
)
(defun dlina(sp / pr tippr sumdl i)
  (setq i 0 sumdl 0)
  (if sp
    (while(setq pr(car(nth i sp)))
      (setq tippr(cdr(assoc 0 (entget pr)))i(1+ i))
      (setq sumdl
        (+ sumdl
          (cond
            ((= tippr"LINE")(distance(cdr(assoc 10(entget pr)))(cdr(assoc 11(entget pr)))))
            ((= tippr"ARC")(*(abs(-(cdr(assoc 50(entget pr)))(cdr(assoc 51(entget pr)))))(cdr(assoc 40(entget pr)))))
          )
        )
      )
    )
  )
  (foreach p sp(redraw(car p)3))
  (list sumdl(length sp))
)
(defun uzel(prim1 koord tch / kon1 koord1 n i pr lay sp)
  (setq sp(list(list prim1 koord))i 0 lay(cdr(assoc 8(entget prim1))))
  (while(setq pr(car(nth i sp)))
    (setq koord1(raschkoord pr 0))
    (if(equal(car(cdr(nth i sp)))koord1 tch)(setq koord1(raschkoord pr 1)))
    (setq kon1
      (ssget"_C"
        (list(-(car koord1)tch)(-(cadr koord1)tch))
        (list(+(car koord1)tch)(+(cadr koord1)tch))
        (list(cons 0"LINE,ARC")(cons 8 lay))
      ) n 0
    )
    (repeat(sslength kon1)
      (if
    (and
          (or(equal(raschkoord(ssname kon1 n)1)koord1 tch)(equal(raschkoord(ssname kon1 n)0)koord1 tch))
      (not(memb(ssname kon1 n)sp))
      (not(equal(cdr(assoc 10(entget(ssname kon1 n))))(cdr(assoc 11(entget(ssname kon1 n))))tch))
    )
        (setq sp(append sp(list(list(ssname kon1 n)koord1))))
      )
      (setq n(1+ n))
    )
    (setq kon1 nil i(1+ i))
  )
  sp
)

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Здравствуйте Борис, извиняюсь,что долго не отвечал к сожалению идей пока нет, может со временем появяться.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Что-то у меня она не работает, пишет неизвестная команда, в чем ошибка?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

А какая команда неизвестна?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

"trassa Неизвестная команда "TRASSA".  Для вызова справки нажмите F1."
Что не так делаю?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

После загрузки текста программки необходимо ввести в командной строке например (trassa 0.1)

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Пишет вот что: "(trassa 0.1) ; ошибка: no function definition: TRASSA"

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Скопируйте весь текст программки в стандартный блокнот, затем сохраните файл с расширением .lsp. После этого мышкой перенесите сохраненный файл в окно Автокада. После этого программка загрузится, о чем будет информация в коммандной строке. После этого вызывайте (trassa 0.1)

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Извиняюсь за настойчивость, но пишет что программа загрузилась, потом вот что:
Команда: (trassa 0.1) Укажите любой элемент трассы: (указываю)
; ошибка: неверный тип аргумента: lselsetp nil

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Андрей, спасибо за настойчивость! Попробуйте нижеприведенный вариант.
(defun trassa(tch / prim1 dl)
(setvar"cmdecho"0)(command"_.regen")(setvar"cmdecho"1)
(while(not(setq prim1(car(entsel"Укажите любой элемент трассы: \n")))))
(if(raschkoord prim1 0)
(progn
(setvar"cmdecho"0)(command"_.ZOOM""_E")
(setq dl(dlina(append(uzel prim1(raschkoord prim1 0)tch)(cdr(uzel prim1(raschkoord prim1 1)tch)))))
(command"_.ZOOM""_P")(setvar"cmdecho"1)
dl
)
(progn(princ"Это не отрезок и не дуга!")(princ))
)
)
(defun raschkoord(prim1 p / tipprim)
(setq tipprim(cdr(assoc 0(entget prim1))))
(cond
((= tipprim"LINE")(cdr(assoc(+ 10 p)(entget prim1))))
((= tipprim"ARC")
(polar(cdr(assoc 10(entget prim1)))(cdr(assoc(+ 50 p)(entget prim1)))(cdr(assoc 40(entget prim1))))
)
)
)
(defun memb(mb sp1 / ind)
(foreach p sp1
(if(eq mb(car p))(setq ind T))
)
ind
)
(defun dlina(sp / pr tippr sumdl i)
(setq i 0 sumdl 0)
(if sp
(while(setq pr(car(nth i sp)))
(setq tippr(cdr(assoc 0 (entget pr)))i(1+ i))
(setq sumdl
(+ sumdl
(cond
((= tippr"LINE")(distance(cdr(assoc 10(entget pr)))(cdr(assoc 11(entget pr)))))
((= tippr"ARC")(*(abs(-(cdr(assoc 50(entget pr)))(cdr(assoc 51(entget pr)))))(cdr(assoc 40(entget pr)))))
)
)
)
)
)
(foreach p sp(redraw(car p)3))
(list sumdl(length sp))
)
(defun uzel(prim1 koord tch / kon1 koord1 n i pr lay sp)
(setq sp(list(list prim1 koord))i 0 lay(cdr(assoc 8(entget prim1))))
(while(setq pr(car(nth i sp)))
(setq koord1(raschkoord pr 0))
(if(equal(car(cdr(nth i sp)))koord1 tch)(setq koord1(raschkoord pr 1)))
(setq kon1
(ssget"_C"
(list(-(car koord1)tch)(-(cadr koord1)tch))
(list(+(car koord1)tch)(+(cadr koord1)tch))
(list(cons 0"LINE,ARC")(cons 8 lay))
) n 0
)
(repeat(sslength kon1)
(if
(and
(or(equal(raschkoord(ssname kon1 n)1)koord1 tch)(equal(raschkoord(ssname kon1 n)0)koord1 tch))
(not(memb(ssname kon1 n)sp))
(not(equal(cdr(assoc 10(entget(ssname kon1 n))))(cdr(assoc 11(entget(ssname kon1 n))))tch))
)
(setq sp(append sp(list(list(ssname kon1 n)koord1))))
)
(setq n(1+ n))
)
(setq kon1 nil i(1+ i))
)
sp
)

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Не получается, пишет то же самое.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Попробуйте вот в таком варианте.
(defun trassa(tch / prim1 dl uz1 uz2)
  (setvar"cmdecho"0)(command"_.regen")(setvar"cmdecho"1)
  (while(not(setq prim1(car(entsel"Укажите любой элемент трассы: \n")))))
  (if(raschkoord prim1 0)
    (progn
      (setvar"cmdecho"0)(command"_.ZOOM""_E")
      (setq
    uz1(uzel prim1(raschkoord prim1 0)tch)
    uz2(iskl uz1(uzel prim1(raschkoord prim1 1)tch))
    dl(dlina(append uz1 uz2))
      )
      (command"_.ZOOM""_P")(setvar"cmdecho"1)
      dl
    )
    (progn(princ"Это не отрезок и не дуга!")(princ))
  )
)
(defun iskl(sp1 sp2 /)
  (foreach p sp1(setq sp2(vl-remove-if'(lambda(g)(eq(car g)(car p)))sp2)))
  sp2
)
(defun raschkoord(prim1 p / tipprim)
  (setq tipprim(cdr(assoc 0(entget prim1))))
  (cond
    ((= tipprim"LINE")(cdr(assoc(+ 10 p)(entget prim1))))
    ((= tipprim"ARC")
      (polar(cdr(assoc 10(entget prim1)))
               (cdr(assoc(+ 50 p)(entget prim1)))
               (cdr(assoc 40(entget prim1)))
      )
    )
  )
)
(defun memb(mb sp1 / ind)
  (foreach p sp1(if(eq mb(car p))(setq ind T)))ind
)
(defun dlina(sp / pr tippr sumdl i)
  (setq i 0 sumdl 0)
  (if sp
    (while(setq pr(car(nth i sp)))
      (setq tippr(cdr(assoc 0 (entget pr)))i(1+ i))
      (setq sumdl
        (+ sumdl
          (cond
            ((= tippr"LINE")
              (distance(cdr(assoc 10(entget pr)))(cdr(assoc 11(entget pr))))
            )
            ((= tippr"ARC")
              (*(abs(-(cdr(assoc 50(entget pr)))(cdr(assoc 51(entget pr)))))
                 (cdr(assoc 40(entget pr)))
              )
            )
          )
        )
      )
    )
  )
  (foreach p sp(redraw(car p)3))
  (list sumdl(length sp))
)
(defun uzel(prim1 koord tch / kon1 koord1 n i pr lay sp)
  (setq sp(list(list prim1 koord))i 0 lay(cdr(assoc 8(entget prim1))))
  (while(setq pr(car(nth i sp)))
    (setq koord1(raschkoord pr 0))
    (if(equal(car(cdr(nth i sp)))koord1 tch)(setq koord1(raschkoord pr 1)))
    (setq kon1
      (ssget"_C"
        (list(-(car koord1)tch)(-(cadr koord1)tch))
        (list(+(car koord1)tch)(+(cadr koord1)tch))
        (list(cons 0"LINE,ARC")(cons 8 lay))
      ) n 0
    )
    (if kon1
      (repeat(sslength kon1)
        (if
      (and
                (or(equal(raschkoord(ssname kon1 n)1)koord1 tch)
                     (equal(raschkoord(ssname kon1 n)0)koord1 tch)
                )
        (not(memb(ssname kon1 n)sp))
        (not(equal(cdr(assoc 10(entget(ssname kon1 n))))
                                (cdr(assoc 11(entget(ssname kon1 n))))tch)
                )
      )
          (setq sp(append sp(list(list(ssname kon1 n)koord1))))
        )
        (setq n(1+ n))
      )
    )
    (setq kon1 nil i(1+ i))
  )
  sp
)

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Почему-то показывает длину только того отрезка, который выбираю из трассы.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Какая у Вас версия Автокада?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

AutoCAD 2008.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Цены бы этой программе не было если бы она понимала клотоиды

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Андрей, не знаю почему у Вас не работает моя программка. Пока не знаю, разбираюсь.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

> SNK
Поставте задачу, может будет понимать и клотоиды. Кстати у Вас программка работает?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

> SNK
Насколько я понимаю клотоиды образуются путем сопряжения отрезков и дуг, поэтому программка вполне может работать и с клотоидами.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

> Борис Глумов
Борис, когда выбираю участок трассы, в командной строке пишет: например (19318.9 1) - длину этого участка, и выделяет тот отрезок трассы - на который указывал курсором, далее когда нажимаю на Esc, он остается выделенным.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

> AndreyW
Да, это штатное завершение работы. Программка возвращает суммарную длину сегментов трассы и их количество и подсвечивает их. В Вашем случае выбирается только один сегмент и соответственно возвращается длина этого сегмента и количество - 1. (длина кол). Выделение не остается, а включается подсветка обсчитанной трассы, в Вашем случае - единственного сегмента. Программка должна находить подстыкованные элементы к концам выбранного примитива и т.д.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

> AndreyW
Пришлите мне, пожалуйста, файл .dwg в котором нарисована трасса. Спасибо.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

Борис, большое спасибо все работает, очень помогает ваша програмка.

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

P.S. а как правильно написать команду для кнопки?

Re: Lisp.Длина трассы из отрезков и дуг, с ответвлениями.

P.S. вопрос снят, все сделал.