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

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

Нужно посчитать кабель

Ответ
Поиск в этой теме
Непрочитано 23.10.2007, 10:25
Нужно посчитать кабель
Shoorup
 
Минск
Регистрация: 16.09.2006
Сообщений: 1,587

Необходимо посчитать длину кабеля.
Есть чертеж, в нем есть есть куча однострочных текстов такого формата (всегда один и тот же) 1230-3х1 (например). Т.е сначало идет длинна кабеля, а потом его жильность.
нужно сложить все кабели например 3х1, потом 4х2, потом, 7х1, 12х2 и т.д. Полученные данные свести в таблицу. Как мне кажеться это задача не очень сложная, но проблемма в том что я совсем не знаю Лиспа.
Если кто может помочь буду признателен
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Просмотров: 44942
 
Автор темы   Непрочитано 26.10.2007, 14:09
#21
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Эх! поюзал прожку! Супер короче получилось. Вот появилось желание ее немного усовершенствовать... Наглеть так наглеть

Модифицировать ее нужно таким образом чтобы она еще считала сколько муфт подземных нужно заложить. 1 муфта ставиться для сращивания кабеля больше 350 метров. если меньше то не ставиться. если кабель 355-700 метров то ставиться 1 муфта.705м -2, и т.д.
Т.е. алгоритм примерно так: (Lк/350)-полученное число округлить в большую сторону (например: 1100/350=3.14 =>округляем в большую сторону =4). и отнимаем 1 = 3
Но есть еще одна проблемма: для каждого кабеля свои муфты. их 3: С-35М, С-50М, С-65М с числом жил соответственно19,42,61.
т.е. нужно еще и вычислить число жил. Для этого перемножаем его и получаем число жил (например 2х3=6 жил, 24х2 =48 жил) ну а по полученным данным посчитать сколько каких муфт нужно.
Вот такая вот задачка...

А это немного исправленный лисп программы которую нужно доработать:
Вложения
Тип файла: rar LCAB.rar (1.1 Кб, 158 просмотров)
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 26.10.2007, 16:06
#22
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 773


Сильно возиться сейчас некогда - накидал буквально за 20 минут. Посмотри, правильно ли я понял смысл:
Код:
[Выделить все]
(defun c:lcab (/ adoc asel dat fst len mod pnt row str suf tbl tmp)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
  )
  (vla-clear asel)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (setq str (vl-string-translate "х" "x" (strcase (vla-get-textstring i) t)))
    (if (and (/= (setq suf (vl-string-left-trim "0123456789" str)) str)
             (= (substr suf 1 1) "-")
             (/= (setq suf (substr suf 2)) "")
             (wcmatch suf "#x#,##x#,#x#(#),##x#(#),#(#),##(#),#x#(##),##x#(##),#(##),##(##)")
        )
      (setq suf (substr suf 1 (vl-string-position 40 suf))
            dat (if (setq len (atof (substr str 1 (vl-string-position 45 str)))
                          tmp (assoc suf dat)
                    )
                  (subst (append tmp (list len)) tmp dat)
                  (cons (list suf len) dat)
                )
      )
    )
  )
  (if (and (setq dat (mapcar (function (lambda (a) (cons (car a) (lcab_multi-modc (cdr a) 350)))) dat))
           (setq pnt (vl-catch-all-apply (function getpoint) '("Точка вставки таблицы:")))
           (not (vl-catch-all-error-p pnt))
      )
    (if (setq fst (vla-item asel 0)
              mod (vla-get-height fst)
              tbl (vla-addtable
                    (vla-objectidtoobject adoc (vla-get-ownerid fst))
                    (vlax-3d-point (trans pnt 1 0))
                    (+ (length dat) 2)
                    4
                    (* 1.5 mod)
                    (* 9.6 mod)
                  )
        )
      (progn (vla-put-regeneratetablesuppressed tbl :vlax-true)
             (vla-settext tbl 0 0 "Спецификация кабеля")
             (vla-setcellalignment tbl 0 0 acmiddlecenter)
             (vla-setcelltextheight tbl 0 0 mod)
             (vla-settext tbl 1 0 "Жильность")
             (vla-settext tbl 1 1 "Длина")
             (vla-settext tbl 1 2 "Уч.")
             (vla-settext tbl 1 3 "Муфт")
             (vla-setcellalignment tbl 1 0 acmiddlecenter)
             (vla-setcellalignment tbl 1 1 acmiddlecenter)
             (vla-setcellalignment tbl 1 2 acmiddlecenter)
             (vla-setcellalignment tbl 1 3 acmiddlecenter)
             (vla-setcelltextheight tbl 1 0 mod)
             (vla-setcelltextheight tbl 1 1 mod)
             (vla-setcelltextheight tbl 1 2 mod)
             (vla-setcelltextheight tbl 1 3 mod)
             (setq row 1)
             (foreach i (mapcar (function (lambda (a) (nth a dat)))
                                (vl-sort-i (mapcar (function car) dat) (function <))
                        )
               (vla-settext tbl (setq row (1+ row)) 0 (car i))
               (vla-setcellalignment tbl row 0 acmiddlecenter)
               (vla-setcelltextheight tbl row 0 mod)
               (vla-settext tbl row 1 (rtos (apply (function +) (cddr i)) 2 0))
               (vla-setcellalignment tbl row 1 acmiddleright)
               (vla-setcelltextheight tbl row 1 mod)
               (vla-settext tbl row 2 (- (length i) 2))
               (vla-setcellalignment tbl row 2 acmiddleright)
               (vla-setcelltextheight tbl row 2 mod)
               (vla-settext tbl row 3 (cadr i))
               (vla-setcellalignment tbl row 3 acmiddleright)
               (vla-setcelltextheight tbl row 3 mod)
             )
             (vla-setcolumnwidth tbl 1 (* 6.0 mod))
             (vla-setcolumnwidth tbl 2 (* 3.0 mod))
             (vla-setcolumnwidth tbl 3 (* 4.5 mod))
             (vla-put-regeneratetablesuppressed tbl :vlax-false)
             (vla-update tbl)
      )
    )
  )
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
  )
)
(defun lcab_multi-modc (lst mod)
  (cons (apply (function +) (mapcar (function (lambda (x) (/ (fix x) mod))) lst)) lst)
)
Если попал - гуд, если нет... Соррь! Что либо более сложное, как-нить попозже.
Alaspher вне форума  
 
Автор темы   Непрочитано 26.10.2007, 17:11
#23
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Alaspher, Спасибо тебе огромное, все правильно сделал ничего лишнего!!! считает так как надо! впринципе осталось только добавить в конце строку "ИТОГО:" с тремя пунктами:
"С-35М" -до 19 жил (сюда входить будут например(3х2, 19х1, 7х2 и.д.)
"С-50М" -до 42 жил (-\\-)
"С-65М" -до 61 жил (-\\- 30х2,24х2 и т.д.)
для их заполнения нужно просуммировать муфты всё
Если появиться время и не очень сложно добавь пожалуйста
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 26.10.2007, 19:33
#24
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 773


Пробуй так
Код:
[Выделить все]
(defun c:lcab (/ adoc alay asel dat fst len lock mod pnt row str suf tbl tmp)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (setq str (vl-string-translate "х" "x" (strcase (vla-get-textstring i) t)))
    (if
      (and (/= (setq suf (vl-string-left-trim "0123456789" str)) str)
           (= (substr suf 1 1) "-")
           (/= (setq suf (substr suf 2)) "")
           (wcmatch suf "#x#,##x#,#x#(#),##x#(#),#(#),##(#),#x#(##),##x#(##),#(##),##(##)")
      )
       (setq suf (substr suf 1 (vl-string-position 40 suf))
             dat (if (setq len (atof (substr str 1 (vl-string-position 45 str)))
                           tmp (assoc suf dat)
                     )
                   (subst (append tmp (list len)) tmp dat)
                   (cons (list suf len) dat)
                 )
       )
    )
  )
  (if (and (setq
             dat (mapcar (function (lambda (a) (cons (car a) (lcab_multi-modc (cdr a) 350))))
                         dat
                 )
           )
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      4
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация кабеля")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Жильность")
          (vla-settext tbl 1 1 "Длина")
          (vla-settext tbl 1 2 "Уч.")
          (vla-settext tbl 1 3 "Муфт")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcellalignment tbl 1 2 acmiddlecenter)
          (vla-setcellalignment tbl 1 3 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcelltextheight tbl 1 2 mod)
          (vla-setcelltextheight tbl 1 3 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-setcolumnwidth tbl 2 (* 3.0 mod))
          (vla-setcolumnwidth tbl 3 (* 4.5 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i (mapcar (function (lambda (a) (nth a dat)))
                             (vl-sort-i (mapcar (function car) dat) (function <))
                     )
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (rtos (apply (function +) (cddr i)) 2 0))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
            (vla-settext tbl row 2 (- (length i) 2))
            (vla-setcellalignment tbl row 2 acmiddleright)
            (vla-setcelltextheight tbl row 2 mod)
            (vla-settext tbl row 3 (cadr i))
            (vla-setcellalignment tbl row 3 acmiddleright)
            (vla-setcelltextheight tbl row 3 mod)
          )
          (if (setq
                dat (lcab_mindex
                      (mapcar (function lcab_multir)
                              (vl-remove-if (function (lambda (x) (zerop (cadr x)))) dat)
                      )
                    )
              )
            (progn (if lock
                     (vla-put-lock alay :vlax-true)
                   )
                   (vla-endundomark adoc)
                   (vla-startundomark adoc)
                   (if lock
                     (vla-put-lock alay :vlax-false)
                   )
                   (vla-insertrows tbl (setq row (1+ row)) (* 1.8 mod) (1+ (length dat)))
                   (vla-mergecells tbl row row 0 3)
                   (vla-settext tbl row 0 "ИТОГО МУФТ")
                   (vla-setcellalignment tbl row 0 acmiddlecenter)
                   (vla-setcelltextheight tbl row 0 mod)
                   (foreach i (mapcar (function (lambda (a) (nth a dat)))
                                      (vl-sort-i (mapcar (function car) dat) (function <))
                              )
                     (vla-mergecells tbl (setq row (1+ row)) row 0 2)
                     (vla-settext tbl row 0 (car i))
                     (vla-setcellalignment tbl row 0 acmiddleleft)
                     (vla-setcelltextheight tbl row 0 mod)
                     (vla-settext tbl row 3 (cadr i))
                     (vla-setcellalignment tbl row 3 acmiddleright)
                     (vla-setcelltextheight tbl row 3 mod)
                   )
            )
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
  )
)
(defun lcab_multi-modc (lst mod)
  (cons (apply (function +) (mapcar (function (lambda (x) (/ (fix x) mod))) lst)) lst)
)
(defun lcab_multir (lst / lns str x)
  (setq str (car lst)
        lns (if (setq x (vl-string-position 120 str))
              (* (atoi (substr str 1 (1+ x))) (atoi (substr str (+ x 2))))
              (atoi str)
            )
  )
  (list (cond ((not (zerop (/ lns 62))) "N/A")
              ((not (zerop (/ lns 43))) "С-65М")
              ((not (zerop (/ lns 20))) "С-50М")
              ("С-35М")
        )
        (cadr lst)
  )
)
(defun lcab_mindex (lst / a asc ret)
  (if lst
    (if (setq ret (lcab_mindex (cdr lst))
              a   (car lst)
              asc (assoc (car a) ret)
        )
      (subst (list (car a) (+ (cadr a) (cadr asc))) asc ret)
      (cons a ret)
    )
  )
)
*Прим.: Обрати внимание на критерий разделения по муфтам - я посчитал, что до 19 жил это включительно, т.е. меньше 20, для остальных аналогично.

Последний раз редактировалось Alaspher, 27.10.2007 в 12:21. Причина: корректировка кода
Alaspher вне форума  
 
Автор темы   Непрочитано 27.10.2007, 08:25
#25
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Alaspher, Всё правильно! Просто Супер!!! Большего пока я думаю очень не скоро потребуется. Время расчета кабеля и соединительных муфт сократилось во много раз.
Видили бы вы глаза людей которым я показывал как эта программа работает. то что они раньше считали и пересчитывали вручную (от 15 мин. до нескольких часов (в зависимости от кол-ва чертежей)) теперь можно посчитать за пару секунд!!!

Ещё раз огромное спасибо Alaspher за помощь!
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 27.10.2007, 12:27
#26
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 773


Shoorup
Рад, что получилось.
Код немного подредактировал (в предпоследнем посте), ничего не изменял в сути - добавил обраобтку блокировки текущего слоя и двухступенчатый откат. Что-б долго не объяснять в чём его смысл, просто попробуй использовать Ctrl+Z после выполнения команды lcab.
Alaspher вне форума  
 
Автор темы   Непрочитано 28.10.2007, 20:40
#27
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Чесно говоря не понял в чем фишка. для красаты можно например сделать чтобы жильность кабель отображалась по порядку. Т.Е. сначала идет не парный кабель 3х1, ит.д. а потом парный 3х2... Причем тот кабель который отображается как 3 - должен в таблице выглядеть как 3х1.
На самом деле главная цель достигнута и даже перевыполнена а красивости не самое главное в жизни, но если все будет отображаться в том порядке как положено будет немного удобней.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 28.10.2007, 21:48
#28
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 773


Код:
[Выделить все]
(defun c:lcab (/ adoc alay asel dat fst len lock mod pnt row str suf tbl tmp)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        asel (vla-get-activeselectionset adoc)
        alay (vla-get-activelayer adoc)
  )
  (vla-clear asel)
  (vla-startundomark adoc)
  (pl:obj-select-on-screen asel "TEXT")
  (vlax-for i asel
    (setq str (vl-string-translate "х" "x" (strcase (vla-get-textstring i) t)))
    (if
      (and (/= (setq suf (vl-string-left-trim "0123456789" str)) str)
           (= (substr suf 1 1) "-")
           (/= (setq suf (substr suf 2)) "")
           (wcmatch suf "#x#,##x#,#x#(#),##x#(#),#(#),##(#),#x#(##),##x#(##),#(##),##(##)")
      )
       (setq suf (substr suf 1 (vl-string-position 40 suf))
             suf (if (vl-string-position 120 str)
                   suf
                   (strcat suf "x1")
                 )
             dat (if (setq len (atof (substr str 1 (vl-string-position 45 str)))
                           tmp (assoc suf dat)
                     )
                   (subst (append tmp (list len)) tmp dat)
                   (cons (list suf len) dat)
                 )
       )
    )
  )
  (if (and (setq
             dat (mapcar (function (lambda (a) (cons (car a) (lcab_multi-modc (cdr a) 350))))
                         dat
                 )
           )
           (setq pnt (vl-catch-all-apply
                       (function getpoint)
                       '("Точка вставки таблицы <Отказаться>: ")
                     )
           )
           (not (vl-catch-all-error-p pnt))
      )
    (progn
      (if (= (vla-get-lock alay) :vlax-true)
        (progn (vla-put-lock alay :vlax-false) (setq lock t))
      )
      (if (setq fst (vla-item asel 0)
                mod (vla-get-height fst)
                tbl (vla-addtable
                      (vla-objectidtoobject adoc (vla-get-ownerid fst))
                      (vlax-3d-point (trans pnt 1 0))
                      (+ (length dat) 2)
                      4
                      (* 1.8 mod)
                      (* 9.6 mod)
                    )
          )
        (progn
          (vla-put-regeneratetablesuppressed tbl :vlax-true)
          (vla-settext tbl 0 0 "Спецификация кабеля")
          (vla-setcellalignment tbl 0 0 acmiddlecenter)
          (vla-setcelltextheight tbl 0 0 mod)
          (vla-settext tbl 1 0 "Жильность")
          (vla-settext tbl 1 1 "Длина")
          (vla-settext tbl 1 2 "Уч.")
          (vla-settext tbl 1 3 "Муфт")
          (vla-setcellalignment tbl 1 0 acmiddlecenter)
          (vla-setcellalignment tbl 1 1 acmiddlecenter)
          (vla-setcellalignment tbl 1 2 acmiddlecenter)
          (vla-setcellalignment tbl 1 3 acmiddlecenter)
          (vla-setcelltextheight tbl 1 0 mod)
          (vla-setcelltextheight tbl 1 1 mod)
          (vla-setcelltextheight tbl 1 2 mod)
          (vla-setcelltextheight tbl 1 3 mod)
          (vla-setcolumnwidth tbl 1 (* 6.0 mod))
          (vla-setcolumnwidth tbl 2 (* 3.0 mod))
          (vla-setcolumnwidth tbl 3 (* 4.5 mod))
          (vla-put-horzcellmargin tbl (* 0.4 mod))
          (setq row 1)
          (foreach i
                   (mapcar
                     (function (lambda (a) (nth a dat)))
                     (vl-sort-i
                       (mapcar
                         (function (lambda (a / q)
                                     (setq q (car a)
                                           i (1+ (vl-string-position 120 q))
                                     )
                                     (list (atoi (substr q 1 i)) (atoi (substr q (1+ i))))
                                   )
                         )
                         dat
                       )
                       (function
                         (lambda (a b) (or (< (cadr a) (cadr b)) (< (car a) (car b))))
                       )
                     )
                   )
            (vla-settext tbl (setq row (1+ row)) 0 (car i))
            (vla-setcellalignment tbl row 0 acmiddlecenter)
            (vla-setcelltextheight tbl row 0 mod)
            (vla-settext tbl row 1 (rtos (apply (function +) (cddr i)) 2 0))
            (vla-setcellalignment tbl row 1 acmiddleright)
            (vla-setcelltextheight tbl row 1 mod)
            (vla-settext tbl row 2 (- (length i) 2))
            (vla-setcellalignment tbl row 2 acmiddleright)
            (vla-setcelltextheight tbl row 2 mod)
            (vla-settext tbl row 3 (cadr i))
            (vla-setcellalignment tbl row 3 acmiddleright)
            (vla-setcelltextheight tbl row 3 mod)
          )
          (if (setq
                dat (lcab_mindex
                      (mapcar (function lcab_multir)
                              (vl-remove-if (function (lambda (x) (zerop (cadr x)))) dat)
                      )
                    )
              )
            (progn (if lock
                     (vla-put-lock alay :vlax-true)
                   )
                   (vla-endundomark adoc)
                   (vla-startundomark adoc)
                   (if lock
                     (vla-put-lock alay :vlax-false)
                   )
                   (vla-insertrows tbl (setq row (1+ row)) (* 1.8 mod) (1+ (length dat)))
                   (vla-mergecells tbl row row 0 3)
                   (vla-settext tbl row 0 "ИТОГО МУФТ")
                   (vla-setcellalignment tbl row 0 acmiddlecenter)
                   (vla-setcelltextheight tbl row 0 mod)
                   (foreach i (mapcar (function (lambda (a) (nth a dat)))
                                      (vl-sort-i (mapcar (function car) dat) (function <))
                              )
                     (vla-mergecells tbl (setq row (1+ row)) row 0 2)
                     (vla-settext tbl row 0 (car i))
                     (vla-setcellalignment tbl row 0 acmiddleleft)
                     (vla-setcelltextheight tbl row 0 mod)
                     (vla-settext tbl row 3 (cadr i))
                     (vla-setcellalignment tbl row 3 acmiddleright)
                     (vla-setcelltextheight tbl row 3 mod)
                   )
            )
          )
          (vla-put-regeneratetablesuppressed tbl :vlax-false)
          (vla-update tbl)
        )
      )
      (if lock
        (vla-put-lock alay :vlax-true)
      )
    )
  )
  (vla-endundomark adoc)
  (princ)
)
(defun pl:obj-select-on-screen (sel enttype)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
  )
)
(defun lcab_multi-modc (lst mod)
  (cons (apply (function +) (mapcar (function (lambda (x) (/ (fix x) mod))) lst)) lst)
)
(defun lcab_multir (lst / lns str x)
  (setq str (car lst)
        lns (if (setq x (vl-string-position 120 str))
              (* (atoi (substr str 1 (1+ x))) (atoi (substr str (+ x 2))))
              (atoi str)
            )
  )
  (list (cond ((not (zerop (/ lns 62))) "N/A")
              ((not (zerop (/ lns 43))) "С-65М")
              ((not (zerop (/ lns 20))) "С-50М")
              ("С-35М")
        )
        (cadr lst)
  )
)
(defun lcab_mindex (lst / a asc ret)
  (if lst
    (if (setq ret (lcab_mindex (cdr lst))
              a   (car lst)
              asc (assoc (car a) ret)
        )
      (subst (list (car a) (+ (cadr a) (cadr asc))) asc ret)
      (cons a ret)
    )
  )
)
Так?

Особых фишек и нет, просто я сделал возможность отказаться от заполнения подсчёта муфт не удаляя подсчёт кабеля.
Alaspher вне форума  
 
Автор темы   Непрочитано 29.10.2007, 09:06
#29
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Немного не так, кабели 3х1, 12х1, идут первыми, а потом, 3х2, 7х2 и т.д.
__________________
Поезд который устал от ржавого здравомыслия рельсов...

Последний раз редактировалось Shoorup, 29.10.2007 в 13:01.
Shoorup вне форума  
 
Автор темы   Непрочитано 24.01.2008, 16:57
#30
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Alaspher, ещё раз тебе огромное спасибо от нашей группы проектировщиков и от меня лично!!! Сегодня с помощью выше написанной программы был спасен проект! Ну очень нужная и полезная программа!
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 25.01.2008, 09:53
#31
Alaspher


 
Регистрация: 11.10.2004
e•burg
Сообщений: 773


Спасибо, за добрые слова!
Alaspher вне форума  
 
Автор темы   Непрочитано 30.04.2009, 09:39
#32
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Появилась новая необходимость внести изменения в программу. Очень хочется чтобы тот кабель который был посчитан выделился цветом, например синим. Если не сложно, доработайте ктонить програмку плиз
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 30.04.2009, 10:04
#33
VVA

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


Shoorup, Дай ссылку на код, который в итоге используешь или опубликуй снова
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 30.04.2009, 10:10
#34
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Это последний код который использую.
Вложения
Тип файла: lsp LCAB.lsp (7.4 Кб, 133 просмотров)
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 30.04.2009, 18:54
#35
Nikolay 2


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


А можно код подправить так, чтобы он считал записи например такого вида КВКбШвнг 19x1.0 150м, Герда-КВнг 14х2х1.0 75м, т.е. тип кабеля-жильность-(количество пар)-сечение-длина и затем раскладывал и суммировал по типу кабеля, жильности и сечению? Вот была бы вещь нужная в хозяйстве каждого электрика и КИПовца. А то действующий код немного специфичен по способу записи. Обычно записывают так КВКбШвнг 19x1.0 150м, причем метраж пишется во второй строке (если записать mtext_ом, то действующий код не обрабатывает mtext)
Nikolay 2 вне форума  
 
Автор темы   Непрочитано 01.05.2009, 17:23
#36
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Nikolay 2, точно можно. Думаю код даже можно сделать так чтобы каждый мог свою маску сделать и считать как нужно. Для меня этот код подходит как нельзя лучше. Единственное вот доработать это отметить цветом, то что посчитано. Бывает что пропускается что-то, например маска не подходит, нечаяно символ вбит лишний или совмещен текст.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 01.05.2009, 20:31
#37
VVA

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


Shoorup, Пробуй
Nikolay 2 - там разбор текста нужно писать заново. Это я к тому, что подправить=написать заново.
Вложения
Тип файла: lsp LCAB.lsp (7.9 Кб, 130 просмотров)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Автор темы   Непрочитано 01.05.2009, 22:15
#38
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


VVA, спасибо большое! Всё работает как надо.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 02.05.2009, 17:38
#39
Nikolay 2


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Shoorup, Пробуй
Nikolay 2 - там разбор текста нужно писать заново. Это я к тому, что подправить=написать заново.
Ну а вообще, надеяться можно? Shoorup как то пиво предлагал, я предлагаю тарань (коли случится оказия побывать в Актау (ранее Шевченко)
Nikolay 2 вне форума  
 
Автор темы   Непрочитано 04.05.2009, 17:38
#40
Shoorup


 
Регистрация: 16.09.2006
Минск
Сообщений: 1,587
<phrase 1= Отправить сообщение для Shoorup с помощью Skype™


Прикольно то, что программа приносит дивиденды в виде конфет до сих пор Очень часто народ переставляя кад в очередной раз зовут "установить" программу. Ставлю уже новую версию - очень довольны мелким улучшением.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Нужно посчитать кабель

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно ли сгущение арматуры под колонной при наличии металлич Aleks ManaeFF Прочее. Программное обеспечение 3 19.07.2007 12:02
Нужно ли показывать с спецификации болты, гвозди, анкеры? Колян Прочее. Архитектура и строительство 9 14.09.2006 08:09
Дали задачку на плаксисе посчитать rust-resisting Прочее. Программное обеспечение 1 25.03.2006 13:42
на какие ключи в реестре нужно дать полный доступ stanislav AutoCAD 1 19.10.2005 20:40
Когда нужно утеплять стены подвала? Колян Конструкции зданий и сооружений 15 02.10.2005 00:58