[Voltos]

Уважаемые програмисты, помогите пожалуйста создать лисп программу для автоматической отрисовки схемы разводки кабелй по клемам. Суть задачи в следующем: я пользуюсь AE который выдает мне по принципиальным схемам таблицу соединений в которой приводит данные по устройствам и кабелям подключенным к клемам (насколько мне известно так решают задачу большинство буржуйских САПР). Однако для всех(большинства) привычнее иметь СХЕМУ подключения кабелей. Было бы здорово получить lisp-приложение преобразующее таблицу определенной структуры в чертеж. Примерно так как на рисунке (справа таблица, слева результат). Спасибо всем кому интересно, низкий поклон всем кто поможет ).

[Voltos]

.. кстати вот код ..хм.. некоего разработчика, не полностью, насколько я могу понять в части собственно отрисовки чертежа.. вот только исходные данные они берут из базы данных программы а не с чертежа
код:

Код:

[Выделить все]

(defun klemm0( / xt yt ln nf zag nnf fn ip)
   (setq olderr *error* *error* attrerr)
   (setvar "HIGHLIGHT" 0)(setvar "cmdecho" 0)(setvar "attreq" 0)
   (command "_LAYER" "_M" "klm" "")
   (setvar "regenmode" 0)
   (command "_STYLE" "eskd" "eskdw" 0 1 0 "" "")
   (setvar "REGENMODE" 1)
	(setq x 100 y 300 ymin 300)
	(setq fn (open "c:\\tmp1.zvk" "r"))
	(if fn (progn
	(while (setq str (read-line fn))
	(setq nk (substr str 1 3)
	pr1 (cut(substr str 4 24))
	pr2 (cut(substr str 28 24))
	con (substr str 52 1) per (substr str 53 1) per1 (substr str 54 1)
	 klm (substr str 55 1)
	side (substr str 56 1) me (substr str 57 8) mar (cut(substr str 65 15))
	txt (substr str 80))
	(setq nk1 (cond ((= (substr nk 2 1) " ")(strcat "00" (substr nk 1 1)))
	 ((= (substr nk 3 1) " ")(strcat "0" (substr nk 1 2)))(t nk)))
	(setq nk (cond ((= (substr nk 2 1) " ")(strcat "  " (substr nk 1 1)" "))
	 ((= (substr nk 3 1) " ")(strcat " " (substr nk 1 2)" "))(t nk)))
	(setq pr11 (strcat "X" (cut me) ":" (cut nk1)))
	(if (and (= side "1")(< x 110))(setq x (+ x 150) y 300))
	(setq ip (list x y))
	(cond ((= klm "0")(command "_insert" "kol1" (list x (- y 10)) "" "" "")
(command "_text" "_F" (list (+ x 21) y)(list (+ x 54) y) 3 (substr txt 1 17))
(command "_text" (list (+ x 21) (- y 4.5)) 3 0 (substr txt 18 17))
(command "_text" (list (+ x 21) (- y 9.5)) 3 0 (substr txt 35 17))
	(if (= side "0")(setq x1 (+ x 2))(setq x1 (+ x 62)))(command "_text" (list x1 (- y 5)) 5 0 me)
	(setq y (- y 15)))
	((= klm "1")(command "_insert" "kol2" ip "" "" "")
	(command "_text" (list (+ x 1) (+ y 1)) 3 0 txt)
	(setq y (- y 5)))
	((> klm "1")(command "_insert" "kl" ip "" "" "")
	(if (= klm "3")(progn (setq x1 (if (= side "0")(+ x 44)(+ x 44)))
	(command "_line" (list x1 y) "@0,5" "")))
;(if (> (strlen pr1) 1)(command "_text" "_f" 
;(list (+ x 21)(+ y 1)) (list (+ x 34)(+ y 1)) 3 pr11))
;(if (> (strlen pr2) 1)(command "_text" "_f" 
;(list (+ x 46)(+ y 1)) (list (+ x 59)(+ y 1)) 3 pr11))
	(if (< (atoi mar) 8000)
	(command "_text" (list (+ x 21)(+ y 1)) 3 0 mar))
;	(if (= side "0")(setq pr1 (strcat mar " " (cut pr1)))
;	(setq pr2 (strcat (cut pr2) " " mar)))
	(if (> (strlen pr1) 1)(if (< (strlen pr1) 9)
	(command "_text" (list (+ x 1)(+ y 1)) 3 0 pr1)
	(command "_text" "_f" (list (+ x 1)(+ y 1)) "@18,0" 3 pr1)))
	(if (> (strlen pr2) 1)(if (< (strlen pr2) 9)
	(command "_text" "_r" (list (+ x 79)(+ y 1)) 3 0 pr2)
	(command "_text" "_f" (list (+ x 61)(+ y 1)) "@18,0" 3 pr2)))
	(if (= side "0")
	(command "_text" "_F" (list (+ x 37.5) (+ y 1)) "@6,0" 3 nk)
	(command "_text" "_F" (list (+ x 37.5) (+ y 1)) "@6,0" 3 nk))
;(if(= per1 "2")(command "_line" (list (+ x 80) (+ y 2.5)) "@3,1" "@0,1.5" ""))
;(if(= per1 "1")(command "_line" (list (+ x 80) (+ y 2.5)) "@3,-1" "@0,-1.5" ""))
;(if(= per1 "3")
;(command "_line" (list (+ x 83) (+ y 5)) "@0,-1.5" "@-3,-1" "@3,-1" "@0,-1.5" ""))
;(if(= per "2")(command "_line" (list x (+ y 2.5)) "@-3,1" "@0,1.5" ""))
;(if(= per "1")(command "_line" (list x (+ y 2.5)) "@-3,-1" "@0,-1.5" ""))
;(if(= per "3")
;(command "_line" (list (- x 3) (+ y 5)) "@0,-1.5" "@3,-1" "@-3,-1" "@0,-1.5" ""))
	(if (/= con "0")(progn
	(if (= side "0")(setq x1 (+ x 36.5))(setq x1 (+ x 36.5)))
	(command "_circle" (list x1 (+ y 2.5)) 1)
	(if (or(= con "1")(= con "2"))
	(command "_line" (list x1 y) "@0,1.5" ""))
(if(or(= con "3")(= con "2"))(command "_line" (list x1 (+ 3.5 y)) "@0,1.5" ""))
	))
	(setq y (- y 5)))
	)
	(if (< y ymin) (setq ymin y))
	)(close fn)
	))

[Дима_]

Не смотрите на этот код - это "мракобесие" - данные беруться там из файла c:\tmpl.zvk записанные в неком пользовательсокм формате - затем командными методами с неотключенными привязками - тоесть не точно - в зависимости от привязок и пр. рисуеться чертеж (причем подразумевается, что в чертеже уже есть некие стили и блоки). Короче - мне он напоминает криво выполненное задание курсовой (здесь такие иногда проскакивают). Никакой проверки ошибок, формата и пр - нет. Если Вам нужно нормальное исполнение - расшифруйте как левая часть рисунка получаеться из правой, в каком формате заданны таблицы, какие данные учитываються и пр. Ну и в зависимости от размера получившегося задания - либо сюда, либо в поиск исполнителей.
з.ы. Если-ж хотите сделать сами - здесь это только приветствуется - задавайте конктретные вопросы - что не получается - всегда подкажу(т) если знаю(ем).

[Shoorup]

Offtop: Voltos, та же самая проблема. У буржуев вообще всё как-то сложно и много лишнего. По нашей специальности (СЦБ на ж.д. тр-те), пытались на основе AE реализовать свой САПР. Накушались сполна, благодаря тому, что у буржуев принципиально другой подход и виденье электрических схем. Они почему-то считают, что табличный способ удобней в эксплуатации. Однако он более удобен в проектировании. Мы смогли реализовать только удобный интерфейс для набора принципиальных схем. А вот перегонка их в монтажный вид, в том виде как принято у нас, не увенчались успехом. Вообще если уходить в тему того как оформляют таблицы там и как у нас (у нас было такое время когда для сокращения количества листов в схеме делали таблицу за счет чего сокращалось примерно 60% листов), то у них таблицы выглядят довольно хаотически (Сравнивать довелось Чешские таблицы с нашими). Скажем так обычный инженер сходу точно не разберется что там к чему и почему именно так сделано, в то время как в наших монтажных схемах, думаю сможет разобраться любой техникум.

Посему я думаю перетачивать их софт под нас довольно проблематично

[Voltos]

Насчет "мракобесия".. это часть САПРа реализованного на лиспах и создающего собственную базу данных на основания чертежа. Её можно было бы использовать но она "туповата" в части создания самой схемы и слабой информативности в процессе отрисовки. А привел ее я только для примера как бывает ).. ну да бог с ним.
Задача сводится к следующему:
1-я колонка номера кабелей слева
2-я номера жил в кабеле с номером в первой колонке
3-я колонка номера кабелей справа
4-я номера жил в кабеле с номером в третьей колонке
далее следуют данные о соединении клемм с монтажными компанентами но это в данном случае лишняя информация
8-я колонка содержит номера клемм по порядку (или не по порядку, лишние колонки перед использованием можно и удалить)
Программа должна обьединять жилы для одного кабеля в общую линию в конце которой втавляется номер кабеля в круге или рядом. Далее неплохо было бы добавить марку и обратный адрес, но эта задача требует более детальной подготовки таблицы.
Стиль и форматирование не критичны(наверное, хотя могу выложить *.dwg).Таким образом получается програмка со следующей логикой: подготавливается таблица, запускается лисп с запросом обрабатываемой таблицы, затем запрос точки вставки (или новый файл создается) на котором отрисовывается чертеж.
Блоки клеммных изображений могу создать и выложить, они ГОСТовские. Сам я не в состоянии начать писать в програмированиия я ДУБ .
Так что уповаю исключительно на помощь профессионалов

[zamtmn]

>>Мда.. видимо аксакалам сильно некогда
Из таблиц информацию о подключениях извлекать не интересно и не перспективно. надо из бд электрикала, но таких аксакалов тут нет((
>>Ладно подождем, выбирать не приходится...
тут какраз лучше повыбирать в сторону еплана или е3

[Voltos]

А вот тут не согласен. "Оседланный" САПР я уже получил, осталось одна маленькая функция. Еплан пробывал - не понравился замороченный какой-то.. только это тема не для данной ветки ). Так что ждемс..

[Uduzr]

Пришли пожалуйста dwg принтскрина твоего, попробую сделать. Уточнить хочу таблица которую ты имеешь она в виде объекта таблица автокад? Я бы еще клеммник в виде таблицы сделал..

[Voltos]

dwg в студию!!!!
а вот чертеж в виде таблицы... ну не знаю мало ли кто как подправил табличный стиль.. Но по большому счету все равно.

[Uduzr]

сразу вопрос, я надеюсь на клемму с одной стороны больше 2х проводов не может приходить?

[Voltos]

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

[Uduzr]

Бывает в вашей практике что на одну клемму приходит 2 провода разной маркировки (с одной стороны)?

[Voltos]

Правила это запрещают. Но такая ОШИБКА возможна поэтому неплохо бы иметь проверку (не более 2х проводов с кажной стороны). Номера проводников на одной клемме тоже одинаковые.

[Voltos]

Ну что же, пришла пора выдать первые результаты. Этот код мне написал наш программист. Прошу сильно не ругать, человек впервые освоил лисп.
код:

Код:

[Выделить все]

(vl-load-com)
(defun TB ()
  (setq	main_table (vlax-ename->vla-object (car (entsel)))
	Heading	   (vla-gettext main_table 0 0)
  )
  (setq i 2)

  ;; Считаем количество строк в исодной таблице
  (while (/= (setq cell_text (vla-gettext main_table i 3)) "")
    (setq i (1+ i))
    
  )
  (setq kol_row i)

  ;; Сортируем исходную таблицу методом пузырька, по номеру клемы
  (setq j 1)
  (while (< j i)
    (setq k (- i 1))
    (while (< j k)
      (setq qw	    (- k 1)
	    cellt10 (vla-gettext main_table qw 3)
	    cellt20 (vla-gettext main_table k 3)
      )
      (if (> (atoi cellt10) (atoi cellt20))

	(progn
	  (setq
	    cellt11 (vla-gettext main_table qw 0)
	    cellt12 (vla-gettext main_table qw 1)
	    cellt13 (vla-gettext main_table qw 2)
	    cellt14 (vla-gettext main_table qw 4)
	    cellt15 (vla-gettext main_table qw 5)
	    cellt16 (vla-gettext main_table qw 6)

	    cellt21 (vla-gettext main_table k 0)
	    cellt22 (vla-gettext main_table k 1)
	    cellt23 (vla-gettext main_table k 2)
	    cellt24 (vla-gettext main_table k 4)
	    cellt25 (vla-gettext main_table k 5)
	    cellt26 (vla-gettext main_table k 6)
	  )
	  (vla-settext main_table k 0 cellt11)
	  (vla-settext main_table k 1 cellt12)
	  (vla-settext main_table k 2 cellt13)
	  (vla-settext main_table k 3 cellt10)
	  (vla-settext main_table k 4 cellt14)
	  (vla-settext main_table k 5 cellt15)
	  (vla-settext main_table k 6 cellt16)

	  (vla-settext main_table qw 0 cellt21)
	  (vla-settext main_table qw 1 cellt22)
	  (vla-settext main_table qw 2 cellt23)
	  (vla-settext main_table qw 3 cellt20)
	  (vla-settext main_table qw 4 cellt24)
	  (vla-settext main_table qw 5 cellt25)
	  (vla-settext main_table qw 6 cellt26)
	)
      )
      (setq k (1- k))
    )
    (setq j (1+ j))
  )

  (setq kol_row_new (atoi (vla-gettext main_table (- kol_row 1) 3)))

  ;; После сортировки, копируем данные в таблицу "клемник"
  (setq	pt (getpoint "Введите начальную точку: ")
	X0 (nth 0 pt)
	Y0 (nth 1 pt)
  )

  (command "_.insert" "kol1" (list X0 Y0) 1 1 0)
  ;; Пишет загловок клеммника
  (command "_.text"
	   "в"	   
	   "ц"
	   (list (+ X0 40) (+ Y0 5))
	   2.5 0
	   Heading
  )
  ;; "в" "ц" - выравнивание по центру

  (setq	i 0
	Y (- Y0 5)
  )

  (while (< i kol_row_new)
    (command "_.insert" "kl" (list X0 Y) 1 1 0)
    (setq n_klem (+ i 1))
    ;; Пишем номер клеммы
    (command "_.text" "в" "ц" (list (+ X0 40) (+ Y 1)) 2.5 0 n_klem) ;Выравнивание текста по русским пораметрам (+ Y 1)) 2 0 n_klem) где 2 - высота текста
    (setq j 2)
    (while (< j kol_row)
      (setq cellt10 (vla-gettext main_table j 3))

      (if (= n_klem (atoi cellt10))
	(progn
	  (setq
	    pr_l (vla-gettext main_table j 2)
	    pr_r (vla-gettext main_table j 4)
	  )
	  (command "_.text" (list (+ X0 2) (+ Y 1)) 2.5 0 pr_l) ;текст для номера проводника слева
	  (command "_.text" "в" "р" (list (+ X0 77) (+ Y 1)) 2.5 0 pr_r) ;текст для номера проводника справа
	)
      )
      (setq j (1+ j))
    )

    (setq Y (- Y 5)
	  i (1+ i)
    )
  )

  (sborprov)

)



;;
(defun sborprov	()
  (setq i 2)
  (setq	q (list	(zeros (vla-gettext main_table i 1))
		(zeros (vla-gettext main_table i 5))
	  )
  )
  (setq i 3)
  (while (/= (setq cell_text (vla-gettext main_table i 3)) "")
    (setq q (append q
		    (list (zeros (vla-gettext main_table i 1))
			  (zeros (vla-gettext main_table i 5))
		    )
	    )
    )
    (setq i (1+ i))
  )
  (setq q (vl-remove '"0" q))
  (setq q (acad_strlsort q))
  (setq q (zipofq q))
  (grafofq)

)

;;
(defun zeros (x)
  (cond	((/= x "") x)
	((quote T) "0")
  )
)

;;
(defun zipofq (x)
  (cond
    ((null (car x)) nil)
    ((member (CAR x) (CDR x)) (zipofq (CDR x)))
    (T (cons (car x) (zipofq (cdr x))))
  )
)

;;
(defun grafofq ()
  (setq i 2)
  (setq	q_l (list (zeros (vla-gettext main_table i 1)))
	q_r (list (zeros (vla-gettext main_table i 5)))
  )

  (setq i 3)
  (while (/= (setq cell_text (vla-gettext main_table i 3)) "")
    (setq q_l (append q_l (list (zeros (vla-gettext main_table i 1))))
	  q_r (append q_r (list (zeros (vla-gettext main_table i 5))))
    )
    (setq i (1+ i))
  )

  (setq	n (length q)
	i (- n 1)
	x (- (nth 0 pt) 15)
	y (- (nth 1 pt) (* 5 kol_row_new) 15)
  )
  (while (<= 0 i)
    (setq txt (nth i q))
    (command "_.text" "в" "ц" (list x y) 2.5 0 txt)
;; Рисуем изображения кабелей с радиусом 6мм
    (command "_.circle" (list x y) 6)
    (command "_.line" (list x (+ y 6)) (list x (+ y 10)) "")
    (setq line1 (entlast))
    (setq j (- kol_row 2)
          flag t
	  )
    (while (<= 0 j)
      (setq elem_l     (nth j q_l)
	    elem_r     (nth j q_r)
	    n_klem     (atoi (vla-gettext main_table (+ j 2) 3))
	    n_klemRAVN (atoi (vla-gettext main_table (+ j 2 1) 3))
      )


      (if (= elem_r txt)
	;; рисуем линию от правого клемника к кабелю.
	(progn
	  (if (= flag t)
	    (progn
              (setq flag nil
		    napr (vla-gettext main_table (+ j 2) 6)
              )
	      (command "_.text" "в" "р" (list x (- y 10)) 2 90 napr)
	    )
	    
	  )
	  (setq
	    
	    x0 (nth 0 pt)
	    y0 (nth 1 pt)
	    x1 x0
	    y1 (+ (- y0 (* 5 n_klem)) 2.5)
	    x2 (+ (- x0 15) (* 20 (- i (- n 1))))

	    x0 (+ (nth 0 pt) 80)
	    y0 (nth 1 pt)
	    x1 x0
	    y1 (+ (- y0 (* 5 n_klem)) 2.5)
	    x2 (+ x1 2)
	    y2 (- y0 (* 5 n_klem))
	    x3 (+ (- x0 15) (* 20 (- i (- n 1))))
	  )

	  (if (= n_klem n_klemRAVN)
	    ;; Рисуем вторую линию справа
	    (command "_line" (list x1 y1) (list (+ 2 x2) (+ y1 1)) (list (+ 2 x2) y2) (list x3 y2) "")
	    ;; Рисуем первую линию справа
	    (command "_line" (list x1 y1) (list x2 y1) (list x2 y2) (list x3 y2) "")
	  )
	  (setq line2 (entlast))
	;; Создаем фаски с задаными размерами
	  (command "_.chamfer" "о" "с" 	"_d" 1.2 1.2 "_chamfer" line1 line2)
	)
      )
      
      (if (= elem_l txt)
	;; рисуем линию от левого клемника к кабелю.
	(progn
	  (if (= flag t)
	    (progn
              (setq flag nil
		    napr (vla-gettext main_table (+ j 2) 0)
              )
	      (command "_.text" "в" "р" (list x (- y 10)) 2 90 napr)
	    )
	    
	  )
	  (setq
	    x0 (nth 0 pt)
	    y0 (nth 1 pt)
	    x1 x0
	    y1 (+ (- y0 (* 5 n_klem)) 2.5)
	    x2 (+ (- x0 15) (* 20 (- i (- n 1))))
	  )

	  (if (= n_klem n_klemRAVN)
	    ;; Рисуем вторую линию слева
	    (command "_line" (list x1 y1) (list (- x1 1) (+ y1 1)) (list x2 (+ y1 1)) "")
	    ;; Рисуем первую линию слева
	    (command "_line" (list x1 y1) (list x2 y1) "")
	  )
	  (setq line2 (entlast))
	  (command "_.chamfer" "_d" 1.2 1.2 "_chamfer" line1 line2)
	)
      )

      
      (setq j (1- j))
    )
    (setq i (1- i)
	  x (- x 20)
    )
  )
)

Таблица для "поиграть" в приложении. Блоки изображений клемм также прикладываю (файлы с блоками разместить в каталог с чертежем). Не мешало бы, пожалуй, заменить вставку блоков на рисование прямоугольников.. (просто мысль) и добавить проверки на ошибки.. но уже работает )

[KennyMckormik]

Вообще работает
слегка подправил
добавьте локальные переменные, настройку среды (анализ слоев, стилей линий, текстовых стилей) обработку ошибок

не очень понимаю конечный результат

[Voltos]

вот исходная таблица и результат как должно быть. Заметил что если текущий стиль отличный от "standart" то не работает как надо, интересно почему.
KennyMckormik а что подправил? (если не сложно)