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

Тема: Трассировка линий связи на плане (корректировка)

Помогите скоректировать програмку!!!
Перед началом работы программы нужен запрос на выбор маштаба (1:1, 1:5, 1:10, 1:20, 1:25, 1:40, 1:50, 1:100, 1:200, 1:500, 1:1000) трассировки!
Если это возможно!
;************ TRASSA.LSP — Трассировка линии связи на плане ******
;
;         Разработал  Громов В.В. декабрь 2004.
;
(defun C:TRASSA ( / nug tug tn tk dlina fl inf dl_all)
      (setq echo (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (setq inf (getstring T "\n Служебная информация (объект, этаж, помещение и др.): "))
      (setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME"))  "_trs.txt"))
      (setq nug (getpoint "\n Укажите начальную точку трассировки (ENTER-отказ): "))
(if nug
    (progn
    (if nug (setq tn nug))
    (setq tug 0 dl_all 0)
    (while tug
         (setq tug (getpoint tn "\n Укажите следующую точку трассировки (ENTER-Закончить): "))
         (if tug
             (progn
             (setq tk tug)
             (grdraw tn tk 5 1)
             (setq dlina (distance tn tk))
             (princ "\n Длина текущего сегмента (мм): ") (princ dlina)
             (setq dl_all (+ dl_all dlina))
             (setq tn tk)
         ))
    );while
           (setq dl_all (/ dl_all 1000))
           (princ "\n Суммарная длина всех сегментов (в метрах): ") (princ dl_all)
           (alert (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1)))
           (command "_redraw")
           (setq fl (open fil "a"))
           (princ "\n\n" fl)
           (princ inf fl)
           (princ "\n  ----------------------------------------------" fl)
           (princ (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1) "\n") fl)
           (close fl)
           (princ "\n Информация записана в файл: ") (princ fil)
    ) ;progn
    (princ "\n Отказ.")
)
    (setvar "CMDECHO" echo)
    (princ)
)

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

> Сергей
А зачем вам это нужно, скажите на милость?

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

Re: Трассировка линий связи на плане (корректировка)

Для подчета длины кабелей, труб, траншей и т.д.
Но для этого приходится переводить чертеж в маштаб 1:1 и подсчитывать, так как программа подсчитывает только в маштабе 1:1!!
Хотелось бы это автоматизировать!

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

Re: Трассировка линий связи на плане (корректировка)

А чертить в М1:1 не пробовал?

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

Re: Трассировка линий связи на плане (корректировка)

Дело в том что я Киповец и все чертежы мы берем у наших стоителей, монтажников и т.д.
Они нам выдают уже готовые свои чертежи в различных маштабах а мы на их чертежаш дорисовуем наши кабели траншеи и т.д.
И проблема возникает в том что если пользоватся этой програмкой то не совсем удобно, приходится переводить в маштаб 1:1 и после подсчета обратно!

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

Re: Трассировка линий связи на плане (корректировка)

Насколько я понимаю в начале программы
(princ "\n Введите маштаб: ")
Нужно написать цикл что бы при изменении маштаба (1:1) на (1:100)или любой другой
менялось в строке
(setq dl_all (/ dl_all 1000))
эта самая 1000 на 10 (в зависимости от маштаба)
Только я не вкурсе как это записать правильно! Подскажите пожалуста!

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Трассировка линий связи на плане (корректировка)

> Сергей
Пробуй

;************ TRASSA.LSP — Трассировка линии связи на плане ******
;
; Разработал Громов В.В. декабрь 2004.
; Корректировка Азарко В.А. (VVA) февраль 2006.
;
; Читать подробнее https://www.caduser.ru/forum/topic25197.html
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
(defun mydcl (zagl info-list / fl ret dcl_id)
    (vl-load-com)
    (if (null zagl)
        (setq zagl "Выбор")
    ) ;_ end of if
    (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
    (setq ret (open fl "w"))
    (mapcar '(lambda (x) (write-line x ret))
            (list "mip_msg : dialog { "
                  (strcat "label=\"" zagl "\";")
                  " :list_box {"
                  "alignment=top ;"
                  "width=51 ;"
                  (if (> (length info-list) 26)
                      "height= 26 ;"
                      (strcat "height= " (itoa (+ 3 (length info-list))) ";")
                  ) ;_ end of if
                  "is_tab_stop = false ;"
                  "key = \"info\";}"
                  "ok_cancel;}"
            ) ;_ end of list
    ) ;_ end of mapcar
    (setq ret (close ret))
    (if (setq dcl_id (load_dialog fl))
        (if (new_dialog "mip_msg" dcl_id)
            (progn
                (start_list "info")
                (mapcar 'add_list info-list)
                (end_list)
                (set_tile "info" "0")
                (setq ret (car info-list))
                (action_tile "info" "(setq ret (nth (atoi $value) info-list))")
                (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
                (action_tile "accept" "(done_dialog 1)")
                (start_dialog)
            ) ;_ end of progn
        ) ;_ end of if
    ) ;_ end of if
    (unload_dialog dcl_id)
    (vl-file-delete fl)
    ret
) ;_ end of defun
(defun C:TRASSA ( / nug tug tn tk dlina fl inf dl_all echo scl-list scl)
(vl-load-com)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq scl-list (list "1:1" "1:5" "1:10" "1:20" "1:25" "1:40" "1:50" "1:100" "1:200" "1:500" "1:1000")) ;Перечень масштабов
(if (setq scl (mydcl "Выберите масштаб" scl-list))
(progn
(if (vl-catch-all-error-p
      (vl-catch-all-apply '(lambda ()
    (setq scl (str-str-lst scl ":")
          scl (mapcar '(lambda(x / ret)(if (= (type x) 'STR)(setq ret (atof x))(setq ret 1))(if (= ret 0) 1 ret)) scl))
    (setq scl (/ (cadr scl)(car scl))))))
      (setq scl 1))
(setq inf (getstring T "\n Служебная информация (объект, этаж, помещение и др.): "))
(setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME")) "_trs.txt"))
(setq nug (getpoint "\n Укажите начальную точку трассировки (ENTER-отказ): "))
(if nug
(progn
(if nug (setq tn nug))
(setq tug 0 dl_all 0)
(while tug
(setq tug (getpoint tn "\n Укажите следующую точку трассировки (ENTER-Закончить): "))
(if tug
(progn
(setq tk tug)
(grdraw tn tk 5 1)
(setq dlina (* scl (distance tn tk)))
(princ "\n Длина текущего сегмента (мм): ") (princ dlina)
(setq dl_all (+ dl_all dlina))
(setq tn tk)
))
);while
(setq dl_all (/ dl_all 1000))
(princ "\n Суммарная длина всех сегментов (в метрах): ") (princ dl_all)
(alert (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1)))
(command "_redraw")
(setq fl (open fil "a"))
(princ "\n\n" fl)
(princ inf fl)
(princ "\n ----------------------------------------------" fl)
(princ (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1) "\n") fl)
(close fl)
(princ "\n Информация записана в файл: ") (princ fil)
) ;progn
(princ "\n Отказ.")
)
)
)
(setvar "CMDECHO" echo)
(princ)
)

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

> Сергей
За последствия не отвечаю:

;************ KANAVA.LSP — Трассировка канав на плане ******
;
;                  Разработал  Громов В.В. февраль 2007.
;
(defun C:KANAVA ( / skl nug tug tn tk dlina fl inf dl_all)
      (setq echo (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (setq inf (getstring T "\n Служебная информация: "))
      (setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME"))  "_knv.txt"))
      (if (null skld) (setq skld "1"))
      (initget "1 5 10 20 25 40 50 100 200 500 1000")
      (princ (strcat "\n Задайте масштаб чертежа в пространстве модели [1/5/10/20/25/40/50/100/200/500/1000] <" skld ">: "))
      (setq skl (getint))
      (if (= skl nil) (setq skl (atoi skld)) (setq skld (itoa skl)))
      (setq nug (getpoint "\n Укажите начальную точку трассировки (ENTER-отказ): "))
(if nug
    (progn
    (if nug (setq tn nug))
    (setq tug 0 dl_all 0)
    (while tug
         (setq tug (getpoint tn "\n Укажите следующую точку трассировки (ENTER-Закончить): "))
         (if tug
             (progn
             (setq tk tug)
             (grdraw tn tk 5 1)
             (setq dlina (* (distance tn tk) skl))
             (princ "\n Длина текущего сегмента (мм): ") (princ dlina)
             (setq dl_all (+ dl_all dlina))
             (setq tn tk)
         ))
    );while
           (setq dl_all (/ dl_all 1000))
           (princ "\n Суммарная длина всех сегментов (в метрах): ") (princ dl_all)
           (alert (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1)))
           (command "_redraw")
           (setq fl (open fil "a"))
           (princ "\n\n" fl)
           (princ inf fl)
           (princ "\n  ----------------------------------------------" fl)
           (princ (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1) "\n") fl)
           (close fl)
           (princ "\n Информация записана в файл: ") (princ fil)
    ) ;progn
    (princ "\n Отказ.")
)
    (setvar "CMDECHO" echo)
    (princ)
)

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:KANAVA) (load "kanava")) KANAVA

Информация будет записана в файл в ту же папку, в которой находится рисунок, и полный путь к этому файлу отобразится в командной строке.

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

Re: Трассировка линий связи на плане (корректировка)

Огромное спасибо!!!
У Владимир Громов (2007-02-26 14:00:57)
все работает отлично и правильно! А у VVA (2007-02-26 13:43:22) работает не правильно, но прикольное окошко выскакивает!!

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 25

Re: Трассировка линий связи на плане (корректировка)

> Сергей
Просто ради справедливости. Отличие в 2-х программах только в форме выбора масштаба (это и есть прикольное окошко).
Остальное то же.
Как говорится найди 2 отличия

(setq dlina (* scl (distance tn tk)))
(setq dlina (* (distance tn tk) skl))

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

Re: Трассировка линий связи на плане (корректировка)

А точно извените!! Я просто первую программку плохо протестировал, изначально она мне выдавала при выборе любого маштаба одно и тоже!!
А сечас все впорядке! Что то не досмотрел либо не все скопировал!!!
Спасибо есчо раз!

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

Ради справедливости хочу заявить, что я дополнял свою программу не зная, что VVA тут уже привел свой вариант. Совпадение в названии переменной "skl" - закономерное совпадение, поскольку является сокращением от "scale".

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

Хотя VVA более правильно сократил.

  • На форуме с 11 июня 2005г.
  • Сообщений: 57
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

Хорошая программка, ранешным вариантом пользовался. Но вот пожелание какое. Сейчас в файл записывается только суммарная длина, а нельзя ли в этот же файл записывать и промежуточные отрезки. Ну очень было бы удобно.

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

> Guslav
Записать-то можно, но тогда надо как-то обозначить сегменты на плане.

  • На форуме с 11 июня 2005г.
  • Сообщений: 57
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

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

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

Re: Трассировка линий связи на плане (корректировка)

Забрасывайте переделаную программку VVA в готовые программы!!! Пусть народ пользуется!!

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

Вот что получилось (AutoCAD 2005-2007):

;************ TRASSA.LSP — Трассировка линейных объектов на плане ******
;
;                  Разработал  Громов В.В. Март 2007.
;
(defun C:TRASSA ( / echo cod40 skl fil nug tug tn tk txt dlina fl inf dl_all)
      (setq echo (getvar "CMDECHO"))
      (setvar "CMDECHO" 0)
      (setq cod40 (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
      (setq inf (getstring T "\n Служебная информация: "))
      (setq fil (strcat (getvar "DWGPREFIX") (vl-filename-base (getvar "DWGNAME"))  "_trs.txt"))
      (setq fl (open fil "a"))
      (princ "\n" fl)
      (princ inf fl)
      (if (null skld) (setq skld "1"))
      (initget "1 5 10 20 25 40 50 100 200 500 1000")
      (princ (strcat "\n Задайте масштаб чертежа в пространстве модели [1/5/10/20/25/40/50/100/200/500/1000] <" skld ">: "))
      (setq skl (getint))
      (if (= skl nil) (setq skl (atoi skld)) (setq skld (itoa skl)))
      (setq nug (getpoint "\n Укажите начальную точку трассировки (ENTER-отказ): "))
(if nug
    (progn
    (if nug (setq tn nug))
    (setq tug 0 dl_all 0 n 1)
    (while tug
         (setq tug (getpoint tn "\n Укажите следующую точку трассировки (ENTER-Закончить): "))
         (if tug
             (progn
             (setq tk tug)
             (grdraw tn tk 5 1)
             (setq dlina (* (distance tn tk) skl))
             (setq txt (itoa n))
             (if (= cod40 0)
                 (command "_TEXT" "_m2p" tn tk (/ 400 skl) "" txt)
                 (command "_TEXT" "_m2p" tn tk "" txt)
             )
             (princ "\n Длина текущего сегмента (мм): ") (princ dlina)
             (princ (strcat "\n Длина сегмента № " (itoa n) " в мм: " (rtos dlina 2 1)) fl)
             (setq dl_all (+ dl_all dlina))
             (setq tn tk n (+ n 1))
         ))
    );while
           (setq dl_all (/ dl_all 1000))
           (princ "\n Суммарная длина всех сегментов (в метрах): ") (princ dl_all)
           (alert (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1)))
           (command "_redraw")
           (princ "\n  ----------------------------------------------" fl)
           (princ (strcat "\n Суммарная длина всех сегментов (в метрах): " (rtos dl_all 2 1) "\n") fl)
           (close fl)
           (princ "\n Информация записана в файл: ") (princ fil)
    ) ;progn
    (princ "\n Отказ.")
)
    (setvar "CMDECHO" echo)
    (princ)
)

  • На форуме с 11 июня 2005г.
  • Сообщений: 57
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

Просто замечательно, но  куда трасса-то исчезает с чертежа? А можно сохранить?

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

> Guslav
Трасса отслеживается не объектами AutoCAD'а. Это типа резиновой нити. Команда "_redraw" ее удаляет. И "_zoom" ее удалит. А зачем ее оставлять, разве вы трассируете в пустоте? Я-то предполагал, что линии связи или трубопроводы, или траншеи и так отрисованы на плане.

  • На форуме с 11 июня 2005г.
  • Сообщений: 57
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

Э-э, да. Жадность, наверное smile. Спасибо, программа очень хорошая,  действительно ее можно в готовые поместить.

  • altver
  • Активный участник
  • На форуме с 19 мая 2006г.
  • Сообщений: 312
  • Спасибо: 1

Re: Трассировка линий связи на плане (корректировка)

Да, это хорошо, но вот если бы вместо номеров сегментов печаталось бы в плане расстояние да еще по текущему тексту ( высота буквы) мне было-бы совсем радостно!

  • На форуме с 10 апреля 2008г.
  • Сообщений: 7
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

Просьба большая по программе.
При прокладке трассы создаются цифры маркировки.
Сделайте, пожалуйста, чтобы цифры создавались в слое DEFPOINTS. Если слоя нет, его нужно создать. И хотелось бы, чтобы цифры были желтые :).

  • На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Re: Трассировка линий связи на плане (корректировка)

Ребята! Очень я не люблю возвращаться к законченным объектам. Мои программы совершенно элементарные. Может, сами попробуете усовершенствовать под себя? Всем было бы полезно.

  • На форуме с 10 апреля 2008г.
  • Сообщений: 7
  • Спасибо: 0

Re: Трассировка линий связи на плане (корректировка)

Если б я мог, разве стал бы я кого-то беспокоить. Увы, у меня это займет очень много времени и скорее всего результат будет неутешительный.