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

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

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

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

Необходимо посчитать длину кабеля.
Есть чертеж, в нем есть есть куча однострочных текстов такого формата (всегда один и тот же) 1230-3х1 (например). Т.е сначало идет длинна кабеля, а потом его жильность.
нужно сложить все кабели например 3х1, потом 4х2, потом, 7х1, 12х2 и т.д. Полученные данные свести в таблицу. Как мне кажеться это задача не очень сложная, но проблемма в том что я совсем не знаю Лиспа.
Если кто может помочь буду признателен
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Просмотров: 59047
 
Непрочитано 23.10.2007, 10:32
#2
Кулик Алексей aka kpblc
Moderator

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


Поиск -> "сумм* длин* лин*"
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.10.2007, 10:45
#3
Admin
Administrator


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


Так ему не сумму длин линий надо, а сумму чисел из текста
Admin вне форума  
 
Автор темы   Непрочитано 23.10.2007, 10:55
#4
Shoorup


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


Admin спасибо! тока хотел ответить Алексею
Еслиб знал Лисп получше вопроса думаю небыло бы. Похожих тем не нашел (может плохо искал). да и переделать сильно лисп я не смогу.
Вот список кабелей которые могут встретиться:
3х1,4х1,5х1,12х1,16х1,30х1,33х1,42х1,3х2,4х2,7х2,10х2,12х2,14х2,19х2,24х2,27х2,30х2
длинна кабеля произвольная. может встретиться такая запись 123-3(2) это тоже самое что и 123-3х1. или например 456-7(2) это тоже самое что и 456-7х1
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 11:02
#5
Кулик Алексей aka kpblc
Moderator

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


Упс... Сорри. Все равно, поиск -> "сум*+текст*" выводит http://dwg.ru/f/showthread.php?t=715...E5%EA%F1%F2%2A ; http://dwg.ru/f/showthread.php?t=377...E5%EA%F1%F2%2A ; http://dwg.ru/f/showthread.php?t=217...E5%EA%F1%F2%2A - и все не то
---
Добавлено: пока искал и воевал с лагами, уже предыдущий ответ появился. Будем думать...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.10.2007, 11:48
#6
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,352
<phrase 1=


>>(всегда один и тот же) 1230-3х1
а марки кабеля нет? могу написать парсер dxf чтоб выуживал нужные строчки и суммировал, но будет работать не внутри автокада, а автономно. если надо скинте файлик с чертежем
zamtmn вне форума  
 
Автор темы   Непрочитано 23.10.2007, 12:07
#7
Shoorup


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


Вот пример кабельной сети.
Формат записи везде одинаковый.
Вложения
Тип файла: rar Кабельная Сеть.rar (94.1 Кб, 728 просмотров)
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 12:14
#8
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,352
<phrase 1=


>>123-3(2) это тоже самое что и 123-3х1
те. числа в скобках никак не учитываются? длинна всегда целая? 3х2 это пары, или 2 - сечение и может быть кабель 3х2,5?
zamtmn вне форума  
 
Непрочитано 23.10.2007, 12:38
#9
VVA

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


Пробуй
Код:
[Выделить все]
(defun C:REPORT-CABEL-LENGTH (/ ss items i e str-str-lst combine sort len)
(vl-load-com)
;_ Helper functions
(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 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)
)
;_ End of Helper functions
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i))))
(setq items 
(cons (strcase (vl-string-trim " " (cdr (assoc 1 (entget e))))) items))
)
(setq items (mapcar '(lambda(x)(mapcar '(lambda(y)(vl-string-trim " " y))(str-str-lst x "-"))) items))
(setq items (vl-remove-if '(lambda(x)(/= (length x) 2)) items))
(setq items
(combine items
'(lambda (a b)
(> (cadr a) (cadr b))
)
'(lambda (a b)
(eq (cadr a) (cadr b))
)
)
)
(textscr)
(princ "\n\nCabel    Total length Count\n")
(foreach item items
  (setq len (apply '+ (mapcar 'atof (mapcar 'car item))))
  (if (> len 0)(progn
  (terpri)(princ (cadar item))(princ "       ")
  (princ len)(princ "        ")(princ (length item))
  )
    )
)
)
)
(princ)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 23.10.2007, 12:45
#10
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


Как вариант

Код:
[Выделить все]
;; cabel.lsp
(defun group-by-val (lst / ret tmp)
; by Fatty T.O.H. ()2005 * all rights removed
  (while (car lst)
    (setq tmp (list (vl-remove-if-not
		      (function	(lambda	(a)
				  (equal a (car lst) 1e-12)
				)
		      )
		      lst
		    )
	      )
    )
    (setq ret (cons (car tmp) ret))
    (setq lst (vl-remove-if
		(function (lambda (a)
			    (equal a (car lst) 1e-12)
			  )
		)
		lst
	      )
    )
    (setq tmp nil)
  )

  ret
)

(defun c:cab (/ ed en mk pos sl ss st tmp)

  (if (setq ss (ssget "_X" (list (cons 0 "*TEXT") (cons 1 "*-*"))))
    (progn
      (setq accum nil)
      (while (setq en (ssname ss 0))
	(setq ed (entget en))
	(setq st (cdr (assoc 1 ed)))
	(setq pos (vl-string-position (ascii "-") st))

	(setq sl (substr st 1 pos))
	(setq mk (substr st (+ pos 2)))
	(setq tmp (cons sl mk))
	(setq accum (cons tmp accum))
	(setq tmp nil)
	(ssdel en ss)
      )
      (setq comm (group-by-val accum))
      (setq result
	     (mapcar (function (lambda (x)
				 (list (cdar x)
				       (apply '+
					      (mapcar 'atof
						      (mapcar 'car x)
					      )
				       )
				 )
			       )
		     )
		     comm
	     )
      )
      (alert
	(apply 'strcat
	       (mapcar (function (lambda (a)
				   (strcat a "\n")
				 )
		       )
		       (mapcar (function (lambda (x)
					   (strcat "Êàáåëü "
						   (car x)
						   "  Äëèíà: "
						   (rtos (cadr x) 2 2)
					   )
					 )
			       )
			       result
		       )
	       )
	)
      )
    )
    (alert "0 texts/mtexts selected")
  )
  (princ)
)
~'J'~
fixo вне форума  
 
Автор темы   Непрочитано 23.10.2007, 13:00
#11
Shoorup


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


Цитата:
Сообщение от zamtmn Посмотреть сообщение
>>123-3(2) это тоже самое что и 123-3х1 те. числа в скобках никак не учитываются?
ДА, это тоже самое
Цитата:
Сообщение от zamtmn Посмотреть сообщение
длинна всегда целая?
ДА, и причем она бывает толька кратна 5 метрам. т.е. 5,10,15, 125,275 ит.д. (в примере я брал что попало )
Цитата:
Сообщение от zamtmn Посмотреть сообщение
3х2 это пары, или 2 - сечение и может быть кабель 3х2,5?
это пары. сечение всегда одинаковое (на первом листе указано 0.9) но это не важно
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Автор темы   Непрочитано 23.10.2007, 13:41
#12
Shoorup


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


Спсибо за коды! теперь коментарии к ним.
1й самый подходящий. 2й извините немного сырой и не подходит
есть ряд пожеланий:
-Много лишнего выбирает если весь чертеж выбрать (т.е. считает все тексты)
-Запас (в скобках) учитывать как отдельный кабель не нужно. т.е. кабель 125-10х2(3) и 255-10х2(4) нужно тоже сложить.
-если не очень сложно это реализовать то сделайте чтобы это все заносилось в таблицу которую можно будет в акад вставить.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 14:05
#13
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,352
<phrase 1=


вот че получилось из присланного файла:
30x2,930
10x2,6015
3x2,5325
24x2,2520
14x2,220
19x2,4470
7x2,11500
3x1,2955
12x2,2235
27x2,3125
4x2,1490

програмка тут: http://zcad.by.ru/SUMMATOR.rar
применять: SUMMATOR.exe "Кабельная Сеть.dxf" >result.txt
результат будет в файле result.txt, его можно вставить в exel
в файле SUMMATOR.log перечень всех посчитаных кабелей
//edit:поправил ссылку

Последний раз редактировалось zamtmn, 23.10.2007 в 14:11.
zamtmn вне форума  
 
Автор темы   Непрочитано 23.10.2007, 14:31
#14
Shoorup


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


Спасибо zamtmn! Но данный вид программы не подходит. т.к. ей буду пользоваться не только я и она должна быть максимально проста для пользователей с которыми я работаю. твоей программой просто не захотят пользоваться. нужен конкретно лисп. (я его на кнопку потом посажу и только обезьяна не сможет ей воспользоваться )
в dxf никто чертежи переводить точно не будет и отдельно программулю запускать тоже .а суть программы то что нужно! единственное нужно как в акаде выбирать все кабели вручную. потому как кабель помеченный звездочкой другой.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 14:53
#15
zamtmn

КИПиА
 
Регистрация: 21.03.2005
Tyumen
Сообщений: 1,352
<phrase 1=


ну звиняйте)) чем богаты))
zamtmn вне форума  
 
Непрочитано 23.10.2007, 15:02
#16
Alaspher


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


Вариант:
Код:
[Выделить все]
(defun c:demo (/ 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 (wcmatch str "*-#x#,*-##x#,*-#x#(#),*-##x#(#),*-#(#),*-##(#)")
            (setq dat (if (setq suf (substr (vl-string-left-trim "0123456789" str) 2)
                                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 pnt (vl-catch-all-apply (function getpoint) '("Pick point <Exit>:")))
             (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)
                          2
                          (* 1.5 mod)
                          (* 8.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-setcellalignment tbl 1 0 acmiddlecenter)
                   (vla-setcellalignment tbl 1 1 acmiddlecenter)
                   (vla-setcelltextheight tbl 1 0 mod)
                   (vla-setcelltextheight tbl 1 1 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 +) (cdr i)) 2 0))
                       (vla-setcellalignment tbl row 1 acmiddleright)
                       (vla-setcelltextheight tbl row 1 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))
    )
)
Alaspher вне форума  
 
Автор темы   Непрочитано 23.10.2007, 15:14
#17
Shoorup


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


Alaspher то что нужно!!! 1 ошибочка тока - запас (это то что в скобках) читывать не нужно. т.е. кабель 125-10х2(3) и 255-10х2(4) нужно тоже сложить. да и вообще его не писать в таблице.
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 15:25
#18
Alaspher


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


Попробуй:
Код:
[Выделить все]
(defun c:demo (/ 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 (wcmatch str "*-#x#,*-##x#,*-#x#(#),*-##x#(#),*-#(#),*-##(#)")
            (setq str (substr str 1 (vl-string-position 40 str))
                  dat (if (setq suf (substr (vl-string-left-trim "0123456789" str) 2)
                                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 dat
             (setq pnt (vl-catch-all-apply (function getpoint) '("Pick point <Exit>:")))
             (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)
                          2
                          (* 1.5 mod)
                          (* 8.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-setcellalignment tbl 1 0 acmiddlecenter)
                   (vla-setcellalignment tbl 1 1 acmiddlecenter)
                   (vla-setcelltextheight tbl 1 0 mod)
                   (vla-setcelltextheight tbl 1 1 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 +) (cdr i)) 2 0))
                       (vla-setcellalignment tbl row 1 acmiddleright)
                       (vla-setcelltextheight tbl row 1 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))
    )
)
Alaspher вне форума  
 
Автор темы   Непрочитано 23.10.2007, 15:36
#19
Shoorup


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


Спасибо Alaspher огромнейшее!!! Будешь ехать в Минск - с меня пиво
Все как нужно сделал. мелочи я уже сам доделаю, это не существенно
__________________
Поезд который устал от ржавого здравомыслия рельсов...
Shoorup вне форума  
 
Непрочитано 23.10.2007, 15:41
#20
Alaspher


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


Пользуйся, на здоровье.
Пиво, коль оказия случиться - с удовольствием!
Alaspher вне форума  
Ответ
Вернуться   Форум 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