Линии электрических соединений

Линии электрических соединений · 30.04.2012, 10:09

Прошу помощи в реализации идеи создании линии электрического соединения.

Суть такая, что нужно рисовать две линии - одну горизонтально и от нее сразу вертикальную без нажатия Enter. Нечто подобное есть в AutoCAD Electrical.
Хочется немного расширить/улучшить возможность рисования таких линий.

Более подробно:
1. Линии рисуются только ортогонально. 2. Первая линия может быть как вертикальная так и горизонтальная. 3. Начало второй линии должно начаться автоматически как только курсор выйдет за пределы X или Y.
т.е. например рисуем сначала горизонтальную линию. Тыкаем начальную точку, затем ведем в сторону на некоторое произвольное расстояние, останавливаемся, тянем курсор в верх или низ, выходим за предел Y и начинает рисоваться уже вертикальная линия. Завершаем тыком или по той же схеме продолжаем рисовать "змейку".

Вообще такое возможно то хоть реализовать в AutoCAD?

perpetule · 11.05.2012, 11:47

Alexeipost
См. пост #15
Попробуй свою сетку вставить как внешнюю ссылку в целевой файл. Это решение гораздо легче автогадом переваривается. И еще самый легкий вариунт точка массивом, привязка к ней называется узел в русской локали.

Main Urod · 12.05.2012, 13:45

Цитата:

Сообщение от Shoorup

Вообще такое возможно то хоть реализовать в AutoCAD?

Зачем так сложно?
Вот, попробуй это. Код конечно замусорен, но это не коммерческий вариант, поэтому не вылизан.
Тыкаешь 1 раз, затем ведешь до точки излома. Как пойдут линии видно по "резиновым" нитям. В точке излома тыкаешь второй раз. Линия рисуется сначала вертикальной, затем горизонтальной. Если нужно наоборот, тыкаешь повторно в ту же точку, линии меняются. Выход по правой кнопке мыши.

Сам код:

Код:

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

 
;;;   *********************************************************************************************
;;;   *                                                                                           *
;;;   *                           Функция отрисовки проводников                                   *
;;;   *                                        (начало)                                           *
;;;   *                                                                                           *
;;;   *********************************************************************************************


(defun c:pr-make ()

  ;;  *********************************************************************************************
  ;;  *                                                                                           *
  ;;  *                 ИСПОЛЬЗУЕМЫЕ ПЕРЕМЕННЫЕ                                                   *
  ;;  *                                                                                           *
  ;;  * Системные:                                                                                *
  ;;  *     oldcmdecho       - начальное эхо команд                                               *
  ;;  *     oldclayer        - начальный слой                                                     *
  ;;  *     oldcecolor       - начальный цвет рисования                                           *
  ;;  *     oldceltype       - начальный тип линии                                                *
  ;;  *     oldsnapmode      - начальный тип шага (0-откл 1-вкл)                                  *
  ;;  *     oldosmode        - начальный тип привязки (до 16384-вкл)                              *
  ;;  *     oldgridmode      - начальное состояние сетки                                          *
  ;;  *                                                                                           *
  ;;  * Общие:                                                                                    *
  ;;  *     protype  - тип проводника                                                             *
  ;;  *                0 - нет                                                                    *
  ;;  *                1 - 220 фаза                                                               *
  ;;  *                2 - 220 нейтраль                                                           *
  ;;  *                3 - +24                                                                    *
  ;;  *                4 - -24                                                                    *
  ;;  *                5 - неопределено                                                           *
  ;;  *                6 - земля                                                                  *
  ;;  *                7 - кабель                                                                 *
  ;;  *                                                                                           *
  ;;  *     firstXY          - Координаты 1-й точки                                               *
  ;;  *     firstX           - Координата Х 1-й точки                                             *
  ;;  *     firstY           - Координата Y 1-й точки                                             *
  ;;  *     secondXY         - Координаты 2-й точки                                               *
  ;;  *     secondX          - Координата X 2-й точки                                             *
  ;;  *     secondY          - Координата Y 2-й точки                                             *
  ;;  *                                                                                           *
  ;;  *     mainpolyname     - Имя основной полилинии                                             *
  ;;  *     segname          - Имя нового сегмента                                                *
  ;;  *     konets           - завершение функции рисования                                       *
  ;;  *                        0 - Работаем                                                       *
  ;;  *                        1 - Работа завершена                                               *
  ;;  *     i                - Счетчик                                                            *
  ;;  *                                                                                           *
  ;;  *     prov_col_l       - цвет проводника "фаза"                                             *
  ;;  *     prov_col_n 	     - цвет проводника "нейтраль"                                         *
  ;;  *     prov_col_+24     - цвет проводника "+24DC"                                            *
  ;;  *     prov_col_-24     - цвет проводника "-24DC"                                            *
  ;;  *     prov_col_unc     - цвет проводника "неопределено"                                     *
  ;;  *     prov_col_gnd     - цвет проводника "земля"                                            *
  ;;  *     kabel_col_kab    - цвет проводника "кабель"                                           *
  ;;  *     prov_sloi        - слой в котором будем чертить проводники                            *
  ;;  *     kabel_sloi       - слой в котором будем чертить кабели                                *
  ;;  *                                                                                           *
  ;;  *     objekt_dan       - данные проводника                                                  *
  ;;  *     start_dan        - общие данные для проводника (слой, цвет и т.д.)                    *
  ;;  *     tochki_dan       - список точек проводника                                            *
  ;;  *     ras_dan          - расширенные данные проводника                                      *
  ;;  *     dob_dan          - данные, которые надо добавить в объект с вводом новой точки        *
  ;;  *     object_name      - имя полилинии с которой работаем                                   *
  ;;  *                                                                                           *
  ;;  *                                                                                           *
  ;;  *                                                                                           *
  ;;  *********************************************************************************************


;;;  ***********************************************************************
;;;  *                                                                     *
;;;  *                   ВИД РАСШИРЕННЫХ ДАННЫХ                            *
;;;  *                                                                     *
;;;  *     код   значение   пояснение                                      *
;;;  *     1070    1000     Обозначекние элемента "Провод"                 *
;;;  *             10**     Номер объекта "Провод"                         *
;;;  *             **00     Номер подобъекта (нет, т.к. базовый)           *
;;;  *     1000    ХХХ      Обозначение проводника                         *
;;;  *     1000    ХХХ      Марка провода                                  *
;;;  *     1000    ХХХ      Сечение провода                                *
;;;  *     1000    ХХХ      Цвет провода                                   *
;;;  *     1070             Признак обработки провода                      *
;;;  *              1       Точки соединения не расставлены                *
;;;  *              2       Точки соединений расставлены                   *
;;;  *                                                                     *
;;;  ***********************************************************************




;;;                                                                                               -
;;; Заголовок (начало)                                                                            -
;;;                                                                                               -
  (terpri)				; перевод строки                                          -
  (princ "Функция порисовки проводников") ;_ вывод названия функции                               -
  (terpri)				; перевод строки                                          -
;;;                                                                                               -
;;; Заголовок (конец)                                                                             -
;;;                                                                                               -

;;;                                                                                               -
;;; Сохранение системных переменных (начало)                                                      -
;;;                                                                                               -
  (setq oldcmdecho (getvar "cmdecho"))	; Сохранить значение переменной "cmdecho"                 -
  (setq oldclayer (getvar "clayer"))	; Сохранить текущий слой                                  -
  (setq oldcecolor (getvar "cecolor"))	; Сохранить текущий цвет рисования                        -
  (setq oldceltype (getvar "celtype"))	; Сохранить текущий тип линии                             -
  (setq oldsnapmode (getvar "snapmode")); Сохранить текущее состояние шага (вкл/выкл)             -
  (setq oldosmode (getvar "osmode"))	; Сохранить текущий тип привязки                          -
  (setq oldgridmode (getvar "gridmode")); Сохранить текущее состояние сетки                       -
;;;                                                                                               -
;;; Сохранение системных переменных (конец)                                                       -
;;;                                                                                               -



;;;                                                                                               -
;;; Установка переменных (начало)                                                                 -
;;;                                                                                               -
  (setq protype 0)			; установим стартовое значение типа проводника            -
  (setq konets 0)			; установим признак конца работы                          -
  (setq mainpolyname nil)		; обнулим имя основной полилинии                          -
  (setvar "snapmode" 1)			; Включим шаг                                             -
  (setvar "gridmode" 1)			; Включим сетку                                           -
  (if (< oldosmode 16384)		; проверим, выключена ли объектная привязка               -
    (setvar "osmode" (+ 16384 oldosmode)) ;_ привязка включена. Выключим ее                       -
  )					; конец IF (проверим, выключена ли объектная привязка)    -
  (regapp "sapr_mur")			; зарегистрируем приложение                               -
;;; Настроим таблицу цветов проводника (начало)                                                   -
  (setq prov_col_l 34)			; цвет фазы                                               -
  (setq prov_col_n 140)			; цвет нейтрали                                           -
  (setq prov_col_+24 230)		; цвет +24DC                                              -
  (setq prov_col_-24 5)			; цвет -24DC                                              -
  (setq prov_col_unc 255)		; цвет "неопределено"                                     -
  (setq prov_col_gnd 92)		; цвет земли                                              -
  (setq kabel_col_kab 7)		; цвет кабеля                                             -
;;; Настроим таблицу цветов проводника (конец)                                                    -
  (setq prov_sloi "31-СЭП проводники")	; установим слой в котором будем чертить проводники       -
  (setq kabel_sloi "32-СЭП кабели")	; установим слой в котором будем чертить кабель           -
;;;                                                                                               -
;;; Установка переменных (начало)                                                                 -
;;;                                                                                               -



;;;                                                                                               -
;;; Загрузка файла диалога (начало)                                                               -
;;;                                                                                               -
  (if (<				; проверим наличие файла диалога. нет - выход             -
	(setq dial_file (load_dialog "sapr_provodniki.DCL")) ;_ проверим наличие файла диалога.   -
	0				; проверим наличие файла диалога. нет - выход             -
      )					; проверим наличие файла диалога. нет - выход             -
    (progn				; файл диалога не найден - выход                          -
      (princ "Файл sapr_provodniki.DCL не найден") ;_ выдадим сообщение о ошибке                  -
      (terpri)				; переведем строку                                        -
;;; Восстановление системных переменных перед выходом (начало)                                    -
      (setvar "clayer" oldclayer)	; Восстановить слой                                       -
      (setvar "cecolor" oldcecolor)	; Восстановить текущий цвет рисования                     -
      (setvar "celtype" oldceltype)	; Восстановить тип линии                                  -
      (setvar "snapmode" oldsnapmode)	; Сохранить текущее состояние шага (вкл/выкл)             -
      (setvar "osmode" oldosmode)	; Сохранить текущий тип привязки                          -
      (setvar "gridmode" oldgridmode)	; Восстановить состояние сетки                            -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
;;; Восстановление системных переменных перед выходом (конец)                                     -
      (exit)				; завершим программу                                      -
    )					; конец PROGN файл диалога не найден - выход              -
  )					; конец if проверим наличие файла диалога. нет - выход    -
;;;                                                                                               -
;;; Загрузка файла диалога (конец)                                                                -
;;;                                                                                               -

;;;                                                                                               -
;;; Загрузка диалога "Выбор типа клеммника" (начало)                                              -
;;;                                                                                               -
  (if (not				; проверим наличие диалога                                -
	(new_dialog "provod1" dial_file) ;_ проверим наличие диалога                              -
      )					; Диалог в файле не найден - выход                        -
    (progn				; Диалог не найден - выход                                -
      (princ "Диалог в файле САПР.dcl не найден") ;_ выдадим аварийное сообщение                  -
      (terpri)				; переведем строку                                        -
;;; Восстановление системных переменных перед выходом (начало)                                    -
      (setvar "clayer" oldclayer)	; Восстановить слой                                       -
      (setvar "cecolor" oldcecolor)	; Восстановить текущий цвет рисования                     -
      (setvar "celtype" oldceltype)	; Восстановить тип линии                                  -
      (setvar "snapmode" oldsnapmode) ;_ Сохранить текущее состояние шага (вкл/выкл)              -
      (setvar "osmode" oldosmode)	; Сохранить текущий тип привязки                          -
      (setvar "gridmode" oldgridmode) ;_ Восстановить состояние сетки                             -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
;;; Восстановление системных переменных перед выходом (конец)                                     -
      (exit)				; завершим программу                                      -
    )					; Конец PROGN  Диалог не найден - выход                   -
  )					; Конец IF Диалог в файле не найден - выход               -
;;;                                                                                               -
;;; Загрузка диалога "Выбор типа клеммника" (конец)                                               -
;;;                                                                                               -








;;;                                                                                               -
;;; Реакция диалога на нажатие кнопки (начало)                                                    -
;;;                                                                                               -
  (action_tile				; Реакция на кнопку "220 фаза"                            -
    "b11"
    "(progn
(setq protype 1)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "220 нейтраль"                        -
    "b12"
    "(progn
(setq protype 2)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "+24"                                 -
    "b21"
    "(progn
(setq protype 3)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "-24"                                 -
    "b22"
    "(progn
(setq protype 4)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "неопределено"                        -
    "b31"
    "(progn
(setq protype 5)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "земля"                               -
    "b32"
    "(progn
(setq protype 6)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "кабель"                              -
    "b33"
    "(progn
(setq protype 7)
(done_dialog)
)")
  (action_tile				; Реакция на кнопку "cancel"                              -
    "cancel"
    "(progn
(setq protype 0)
(done_dialog)
)")
;;;                                                                                               -
;;; Реакция диалога на нажатие кнопки (конец)                                                     -
;;;                                                                                               -



;;;                                                                                               -
;;; Запуск диалога  (начало)                                                                      -
;;;                                                                                               -
  (start_dialog)			; запустим диалог                                         -
;;;                                                                                               -
;;; Запуск диалога  (конец)                                                                       -
;;;                                                                                               -


;;;                                                                                               -
;;; Анализ нажатой кнопки  (начало)                                                               -
;;;                                                                                               -
  (if (= protype 0)			; смотрим не была ли это кнопка Cancel                    -
    (progn				; начало PROGN (смотрим не была ли это кнопка Cancel)     -
;;; Восстановление системных переменных перед выходом (начало)                                    -
      (setvar "clayer" oldclayer)	; Восстановить слой                                       -
      (setvar "cecolor" oldcecolor)	; Восстановить текущий цвет рисования                     -
      (setvar "celtype" oldceltype)	; Восстановить тип линии                                  -
      (setvar "snapmode" oldsnapmode)	; Сохранить текущее состояние шага (вкл/выкл)             -
      (setvar "osmode" oldosmode)	; Сохранить текущий тип привязки                          -
      (setvar "gridmode" oldgridmode)	; Восстановить состояние сетки                            -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
;;; Восстановление системных переменных перед выходом (конец)                                     -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
      (exit)				; выход из программы                                      -
    )					; конец PROGN (смотрим не была ли это кнопка Cancel)      -
  )					; смотрим не была ли это кнопка Cancel                    -
;;;                                                                                               -
;;; Анализ нажатой кнопки  (конец)                                                                -
;;;                                                                                               -


;;;                                                                                               -
;;; Сформируем стартовые данные объекта (начало)                                                  -
;;;                                                                                               -
;;; в этой функции i, j используются для временного храннения данных                              -
  (setq start_dan (list (cons 0 "LWPOLYLINE"))) ;_ создадим тип "полилиния"                       -
  (setq start_dan (cons (cons 100 "AcDbEntity") start_dan)) ;_создадим маркер данных подкласса    -
  (setq start_dan (cons (cons 410 "Model") start_dan)) ;_создадим пространство модели             -
  (setq start_dan (cons (cons 100 "AcDbPolyline") start_dan)) ;_создадим маркер данных подкласса  -
  (setq start_dan (cons (cons 90 2) start_dan)) ;_создадим стартовое количество вершин            -
  (cond					; создадим слой и цвет                                    -
    ((= protype 1)			; нажата кнопка "220 фаза"                                -
     (progn				; нажата кнопка "220 фаза"                                -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_l) start_dan)) ;_ зададим цвет для отрисовки       -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "коричневый")); запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "220 фаза"                    -
    )					; конец COND нажата кнопка "220 фаза"                     -
    ((= protype 2)			; нажата кнопка "220 нейтраль"                            -
     (progn				; нажата кнопка "220 нейтраль"                            -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_n) start_dan)) ;_ зададим цвет для отрисовки       -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "голубой"))	; запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "220 нейтраль"                -
    )					; конец COND нажата кнопка "220 нейтраль"                 -
    ((= protype 3)			; нажата кнопка "+24"                                     -
     (progn				; нажата кнопка "+24"                                     -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_+24) start_dan)) ;_ зададим цвет для отрисовки     -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "красный"))	; запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "+24"                         -
    )					; конец COND нажата кнопка "+24"                          -
    ((= protype 4)			; нажата кнопка "-24"                                     -
     (progn				; нажата кнопка "-24"                                     -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_-24) start_dan)) ;_ зададим цвет для отрисовки     -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "синий"))	; запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "-24"                         -
    )					; конец COND нажата кнопка "-24"                          -
    ((= protype 5)			; нажата кнопка "Неопределено"                            -
     (progn				; нажата кнопка "Неопределено"                            -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_unc) start_dan)) ;_ зададим цвет для отрисовки     -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "белый"))	; запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "Неопределено"                -
    )					; конец COND нажата кнопка "Неопределено"                 -
    ((= protype 6)			; нажата кнопка "Земля"                                   -
     (progn				; нажата кнопка "Земля"                                   -
       (setq start_dan (cons (cons 8 prov_sloi) start_dan)) ;_ зададим слой проводника            -
       (setq start_dan (cons (cons 62 prov_col_gnd) start_dan)) ;_ зададим цвет для отрисовки     -
       (setq i (cons 1070 1000))	; запишем тип данных "Провод"                             -
       (setq j (cons 1000 "желто-зеленый")) ;_ запишем цвет изоляции                              -
     )					; конец PROGN нажата кнопка "Земля"                       -
    )					; конец COND нажата кнопка "Земля"                        -
    ((= protype 7)			; нажата кнопка "Кабель"                                  -
     (progn				; нажата кнопка "Кабель"                                  -
       (setq start_dan (cons (cons 8 kabel_sloi) start_dan)) ;_ зададим слой проводника           -
       (setq start_dan (cons (cons 62 kabel_col_kab) start_dan)) ;_ зададим цвет для отрисовки    -
       (setq i (cons 1070 1100))	; запишем тип данных "Кабель"                             -
       (setq j (cons 1000 "белый"))	; запишем цвет изоляции                                   -
     )					; конец PROGN нажата кнопка "Кабель"                      -
    )					; конец COND нажата кнопка "Кабель"                       -
  )					; конец COND создадим слой и цвет                         -
;;;                                                                                               -
;;; Сформируем стартовые данные объекта (конец)                                                   -
;;;                                                                                               -



;;;                                                                                               -
;;; Сформируем стартовые расширенные данные (начало)                                              -
;;;                                                                                               -
  (setq ras_dan (list (cons 1070 1)))	; линия не обработана                                     -
  (setq ras_dan (cons j ras_dan))	; цвет изоляции                                           -
  (setq ras_dan (cons (cons 1000 "???") ras_dan)) ;_ сечение провода                              -
  (setq ras_dan (cons (cons 1000 "???") ras_dan)) ;_ марка провода                                -
  (setq ras_dan (cons (cons 1000 "???") ras_dan)) ;_ позиционное обозначение провода              -
  (setq ras_dan (cons i ras_dan))	; признак группы                                          -
  (setq ras_dan (list -3 (cons "sapr_mur" ras_dan))) ;_подготовим формат данных                   -
;;;                                                                                               -
;;; Сформируем стартовые расширенные данные (конец)                                               -
;;;                                                                                               -



;;;                                                                                               -
;;; Введем стартовую точку (начало)                                                               -
;;;                                                                                               -
  (terpri)				; перевод строки                                          -
  (setq firstpoint (getpoint "Введите координаты стартовой точки: ")) ;_ Ввод первой точки        -
;;; Проверим на "пустой ввод" (начало)                                                            -
  (if (= firstpoint nil)		; смотрим не была ли это кнопка Cancel                    -
    (progn				; начало PROGN (смотрим не была ли это кнопка Cancel)     -
;;; Восстановление системных переменных перед выходом (начало)                                    -
      (print "Пустоы ввод. Выход из программы") ;_ выдадим причину выхода                         -
      (terpri)				; перевод строки                                          -
      (setvar "clayer" oldclayer)	; Восстановить слой                                       -
      (setvar "cecolor" oldcecolor)	; Восстановить текущий цвет рисования                     -
      (setvar "celtype" oldceltype)	; Восстановить тип линии                                  -
      (setvar "snapmode" oldsnapmode)	; Сохранить текущее состояние шага (вкл/выкл)             -
      (setvar "osmode" oldosmode)	; Сохранить текущий тип привязки                          -
      (setvar "gridmode" oldgridmode)	; Восстановить состояние сетки                            -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
;;; Восстановление системных переменных перед выходом (конец)                                     -
      (setvar "cmdecho" oldcmdecho)	; Восстановить значения переменной "cmdecho"              -
      (exit)				; выход из программы                                      -
    )					; конец PROGN (смотрим не была ли это кнопка Cancel)      -
  )					; смотрим не была ли это кнопка Cancel                    -
;;; Проверим на "пустой ввод" (конец)                                                             -
  (setq firstX (fix (nth 0 firstpoint))) ;_ Выделим координату Х первой точки                     -
  (setq firstY (fix (nth 1 firstpoint))) ;_ Выделим координату Y первой точки                     -
  (princ "(")				; Напишем координаты                                      -
  (princ firstX)			; Напишем координаты                                      -
  (princ ":")				; Напишем координаты                                      -
  (princ firstY)			; Напишем координаты                                      -
  (princ ")")				; Напишем координаты                                      -
  (setq tochki_dan (list (list 10 firstX firstY))) ;_ запишем первую точку в список точек         -
;;;                                                                                               -
;;; Введем стартовую точку (конец)                                                                -
;;;                                                                                               -




;;;                                                                                               -
;;; Проверим наличие нужных слоев и создадим слой, если его нет  (начало)                         -
;;;                                                                                               -
  (if (= protype 7)			; смотрим что рисуем: кабель или провод                   -
    (progn				; кабель                                                  -
      (if (= (tblsearch "LAYER" kabel_sloi) nil) ;_ проверим наличие слоя                         -
	(progn				; слоя нет                                                -
	  (entmakex			; создадим слой с:                                        -
	    (list			; создадим слой с:                                        -
	      (cons 0 "LAYER")		; объект типа СЛОЙ                                        -
	      (cons 100 "AcDbSymbolTableRecord") ;_ табличные данные                              -
	      (cons 100 "AcDbLayerTableRecord") ;_ табличные данные                               -
	      (cons 2 kabel_sloi)	; название слоя                                           -
	      (cons 62 21)		; цвет                                                    -
	      (cons 6 "Continuous")	;тип линии                                                -
	      (cons 370 60)		; толщина линии                                           -
	      (cons 70 0)		; параметры слоя                                          -
	    )				; LIST создадим слой с:                                   -
	  )				; ENTMAKEX создадим слой с:                               -
	)				; PROGN слоя нет                                          -
      )					; IF проверим наличие слоя                                -
    )					; PROGN кабель                                            -
    (progn				; провод                                                  -
      (if (= (tblsearch "LAYER" prov_sloi) nil) ;_ проверим наличие слоя                          -
	(progn				; слоя нет                                                -
	  (entmakex			; создадим слой с:                                        -
	    (list			; создадим слой с:                                        -
	      (cons 0 "LAYER")		; объект типа СЛОЙ                                        -
	      (cons 100 "AcDbSymbolTableRecord") ;_ табличные данные                              -
	      (cons 100 "AcDbLayerTableRecord") ;_ табличные данные                               -
	      (cons 2 prov_sloi)	; название слоя                                           -
	      (cons 62 21)		; цвет                                                    -
	      (cons 6 "Continuous")	;тип линии                                                -
	      (cons 370 25)		; толщина линии                                           -
	      (cons 70 0)		; параметры слоя                                          -
	    )				; LIST создадим слой с:                                   -
	  )				; ENTMAKEX создадим слой с:                               -
	)				; PROGN слоя нет                                          -
      )					; IF проверим наличие слоя                                -
    )					; PROGN провод                                            -
  )					; if смотрим что рисуем: кабель или провод                -
;;;                                                                                               -
;;; Проверим наличие нужных слоев и создадим слой, если его нет  (конец)                          -
;;;                                                                                               -



;;;                                                                                               -
;;; Введем последующие точки (начало)                                                             -
;;;                                                                                               -
;;; А) Анализ введенных точек                                                                     -
;;;   1. точка совпадает в предыдущей                                                             -
;;;      1.1 это вторая точка полилинии - игнорируем                                              -
;;;                 - обнулим dob_dan                                                             -
;;;      1.2 это не вторая точка полилинии                                                        -
;;;           1.2.1 предыдущая секция из 1-го отрезка - игнорируем                                -
;;;                 - обнулим dob_dan                                                             -
;;;           1.2.2 предыдущая секция из 2-х отрезков - инвертируем угол                          -
;;;                 - вычесть dob_dan из tochki_dan                                               -
;;;                 - инвертировать среднюю точку блока                                           -
;;;                 - заполнить dob_dan                                                           -
;;;   2. точка на одной вертикали или горизонтали с введенной                                     -
;;;                 - заполнить dob_dan                                                           -
;;;                 - занесем новые данные стартовой точки                                        -
;;;   3. точка по диагонали с вееденной                                                           -
;;;                 - заполнить dob_dan                                                           -
;;;                 - занесем новые данные стартовой точки                                        -
;;; Б) если новые добавочные данные существуем, то дополним список точек                          -
;;; В) создадим новые object_dan полилинии                                                        -
;;; Г) удалим предыдущую полилинию                                                                -
;;; Д) создадим новую полилинию                                                                   -
  (setq dob_dan nil)			; обнулим добавленные данные                              -
  (setq i 0)				; обнулим признак выхода из ввода точек                   -
  (while (= i 0)			; организуем ввод точек до появления пустого ввода        -
    (terpri)				; перевод строки                                          -
    (setq secondpoint			; загрузим координаты точки                               -
	   (getcorner			; указанной                                               -
	     (list firstX firstY)	; с "резиновой нитью"                                     -
	     "Укажите следующую точку: " ;_ и сообщением                                          -
	   )				; указанной                                               -
    )					; загрузим координаты точки                               -
    ;; Проверим на "пустой ввод" (начало)                                                         -
    (if	(= secondpoint nil)		; Смотрим что ввели                                       -
      ;; "пустой ввод" (начало)                                                                   -
      (progn				; "Пустой ввод"                                           -
	(print "Пустой ввод. Завершаем ввод данных") ;_ выведем инфостроку                        -
	(setq i 1)			; выйдем из цикла отрисовки проводника                    -
      )					;конец PROGN "Пустой ввод"                                -
      ;; "пустой ввод" (конец)                                                                    -
      ;; введены координаты (начало)                                                              -
      (progn				; введены координаты                                      -
	(setq secondX (fix (nth 0 secondpoint))) ;_ Выделим координату Х точки                    -
	(setq secondY (fix (nth 1 secondpoint))) ;_ Выделим координату Y точки                    -
	(princ "(")			; Напишем координаты                                      -
	(princ secondX)			; Напишем координаты                                      -
	(princ ":")			; Напишем координаты                                      -
	(princ secondY)			; Напишем координаты                                      -
	(princ ")")			; Напишем координаты                                      -
	;;                                                                                        -
	;; Анализ введенных точек (начало)                                                        -
	;;                                                                                        -
	(cond				; рассмотрим варианты ввода                               -
	  ;; точки совпадает с предыдущей (начало)                                                -
	  ((and				; точки совпадают                                         -
	     (= firstX secondX)		; X совпадает                                             -
	     (= firstY secondY)		; Y совпадает                                             -
	   )				; точки совпадают                                         -
	   (progn			; точки совпадают                                         -
	     (if (= (length dob_dan) 2)	; был угол инвертируем его                                -
	       (progn			; был угол инвертируем его                                -
		 (setq k (list (nth 0 tochki_dan))) ;_ занесем 1-ю точку во временный список      -
		 (if (> (length tochki_dan) 2) ;_ если точек 3 и больше то надо занести еще точек -
		   (progn		; если точек 3 и больше то надо занести еще точек         -
		     (setq m 1)		; установим счетчик                                       -
		     (repeat (- (length tochki_dan) 3) ;_ цикл по точкам которые надо переписать  -
		       (setq k (cons (nth m tochki_dan) k)) ;_ добавим новую т во временнй список -
		       (setq m (+ m 1))	; увеличим счетчик                                        -
		     )			; конец REPEAT цикл по точкам которые надо переписать     -
		     (setq tochki_dan (reverse k)) ;_ перевернем список с координатами точек      -
					; подготовим новые точки (начало)                         -
		     ;; назначим координаты промежуточной точки (начало)                          -
		     (cond		; назначим координаты промежуточной точки                 -
		       ((=		; если X равны                                            -
			  (nth 1 (nth 0 dob_dan)) ;_ X промежуточной точки                        -
			  (nth 1 (nth 1 dob_dan)) ;_ X финишной точки                             -
			)		; если X равны                                            -
			(progn		; если X равны                                            -
			  (setq	dob_dan	; добавим в список добавочных данных                      -
				 (cons ;_ объединение из                                          -
				   (list; списка                                                  -
				     10	; DXF кода вершины                                        -
				     (nth 1 (last tochki_dan)) ;_ X стартовой точки               -
				     (nth 2 (nth 1 dob_dan)) ;_ Y финишной точки                  -
				   )	; конец первого элемента                                  -
				   (list (nth 1 dob_dan)) ;_ коопрдинат финишной точки            -
				 )	; коец объединения                                        -
			  )		; конец "добавим в список добавочных данных"              -
			)		; конец PROGN если X равны                                -
		       )		; конец если X равны                                      -
		       ;; координаты Y равны (начало)                                             -
		       ((=		; если Y равны                                            -
			  (nth 2 (nth 0 dob_dan)) ;_ Y промежуточной точки                        -
			  (nth 2 (nth 1 dob_dan)) ;_ Y финишной точки                             -
			)		; если Y равны                                            -
			(progn		; если Y равны                                            -
			  (setq	dob_dan	; добавим в список добавочных данных                      -
				 (cons ;_ объединение из                                          -
				   (list; списка                                                  -
				     10	; DXF кода вершины                                        -
				     (nth 1 (nth 1 dob_dan)) ;_ X финишной точки                  -
				     (nth 2 (last tochki_dan)) ;_ Y стартовой точки               -
				   )	; конец первого элемента                                  -
				   (list (nth 1 dob_dan)) ;_ коопрдинат финишной точки            -
				 )	; коец объединения                                        -
			  )		; конец "добавим в список добавочных данных"              -
			)		; конец PROGN если Y равны                                -
		       )		; конец если Y равны                                      -
		       ;; координаты Y равны (конец)                                              -
		     )			; конец COND назначим координаты промежуточной точки      -
		     ;; назначим координаты промежуточной точки (конец)                           -
					; подготовим новые точки (конец )                         -
		   )			; конец  PROGN если точек 3 и больше то надо занести ...  -
		 )			; конец IF если точек 3 и больше то надо занести еще точек-
	       )			; конец PROGN был угол инвертируем его                    -
	     )				; конец IF был угол инвертируем его                       -
	   )				; точки совпадают                                         -
	  )				; точки совпадают                                         -
	  ;; точки совпадает с предыдущей (конец)                                                 -
	  ;;                                                                                      -
	  ;;                                                                                      -
	  ;; точка на одной вертикали или горизонтали с введенной (начало)                        -
	  ((or				; точки лежат горизонтально или вертикально               -
	     (= firstX secondX)		; горизонтально                                           -
	     (= firstY secondY)		; вертикально                                             -
	   )				; точки лежат горизонтально или вертикально               -
	   (progn			; точки лежат горизонтально или вертикально               -
	     (setq dob_dan (list (list 10 secondX secondY))) ;_ запишем координаты в список       -
	     (setq firstX secondX)	; сменим стартовую точку X                                -
	     (setq firstY secondY)	; сменим стартовую точку Y                                -
	   )				; конец PROGN точки лежат горизонтально или вертикально   -
	  )				; точки лежат горизонтально или вертикально               -
	  ;; точка на одной вертикали или горизонтали с введенной (конец)                         -
	  ;;                                                                                      -
	  ;;                                                                                      -
	  ;; точка по диагонали с введенной (начало)                                              -
	  ((and				; точки лежат по диагонали                                -
	     (/= firstX secondX)	; X не совпадает                                          -
	     (/= firstY secondY)	; Y не совпадает                                          -
	   )				; точки лежат по диагонали                                -
	   (progn			; точки лежат по диагонали                                -
	     (setq dob_dan (list (list 10 secondX secondY))) ;_ запишем коорд. верт линии в список-
	     (setq dob_dan (cons	; запишем координаты горизонтальной линии в список        -
			     (list 10 firstX secondY) ;_ запишем коорд. гор. линии в список       -
			     dob_dan	; запишем координаты горизонтальной линии в список        -
			   )		; запишем координаты горизонтальной линии в список        -
	     )				; запишем координаты горизонтальной линии в список        -
	     (setq firstX secondX)	; сменим стартовую точку X                                -
	     (setq firstY secondY)	; сменим стартовую точку Y                                -
	   )				; конец PROGN точки лежат горизонтально или вертикально   -
	  )				; точки лежат горизонтально или вертикально               -
	  ;; точка по диагонали с введенной (конец)                                               -
	)				; конец COND рассмотрим варианты ввода                    -
	;;                                                                                        -
	;; Анализ введенных точек (конец)                                                         -
	;;                                                                                        -



	;;                                                                                        -
	;; если новые добавочные данные существуем, то дополним список точек (начало)             -
	;;                                                                                        -
	(if (/= dob_dan nil)		; нам есть что добавить к полилинии. добавим              -
	  (progn			; нам есть что добавить к полилинии. добавим              -
	    (setq tochki_dan (append tochki_dan dob_dan)) ;_ добавим доп. данные в список точек   -
	    ;;                                                                                    -
	    ;; создадим новые object_dan полилинии (начало)                                       -
	    ;;                                                                                    -
	    (setq object_dan start_dan)	; внесем в данные объекта стартовые данные                -
	    (setq j 0)			; выставим счетчик доступа к точкам                       -
	    (repeat (length tochki_dan)	; проведем цикл по точкам полилинии                       -
	      (setq object_dan (cons (nth j tochki_dan) object_dan)) ;_ добавим координаты        -
	      (setq object_dan (cons (cons 40 0.0) object_dan)) ;_ добавим группу 40              -
	      (setq object_dan (cons (cons 41 0.0) object_dan)) ;_ добавим группу 41              -
	      (setq object_dan (cons (cons 42 0.0) object_dan)) ;_ добавим группу 42              -
	      (setq j (+ j 1))		; увеличим счетчик элемента на 1                          -
	    )				; конец REPEAT проведем цикл по точкам полилинии          -
	    ;; изменим параметр количества точек (начало)                                         -
	    (setq object_dan		; сохраним в данные проводника                            -
		   (subst		; проводник с замененными                                 -
		     (cons 90 (length tochki_dan)) ;_ на пару (90 . кол точек)                    -
		     (assoc 90 object_dan) ;_ старой парой                                        -
		     object_dan		; из спмска данных проводника                             -
		   )			; конец SUBST                                             -
	    )				; кронец SETQ                                             -
	    ;; изменим параметр количества точек (конец)                                          -
	    (setq object_dan (cons ras_dan object_dan)) ;_ добавим расширенные данные             -
	    (setq object_dan (reverse object_dan)) ;_ перевернем список                           -
	    ;;                                                                                    -
	    ;; создадим новые object_dan полилинии (конец)                                        -
	    ;;                                                                                    -
	    ;;                                                                                    -
	    ;; удалим предыдущую полилинию (начало)                                               -
	    ;;                                                                                    -
	    (if	(/= mainpolyname nil)	; если это не первая полилиния                            -
	      (entdel mainpolyname)	; то удалим предыдущую                                    -
	    )				; конец IF если это не первая полилиния                   -
	    ;;                                                                                    -
	    ;; удалим предыдущую полилинию (конец)                                                -
	    ;;                                                                                    -
	    ;;                                                                                    -
	    ;; создадим новую полилинию (начало)                                                  -
	    ;;                                                                                    -
	    (setq mainpolyname (entmakex object_dan)) ;_ создадим объект и сохраним его индентифик-
	    ;;                                                                                    -
	    ;; создадим новую полилинию (конец)                                                   -
	    ;;                                                                                    -
	  )				; конец PROGN нам есть что добавить к полилинии. добавим  -
	)				; конец IF нам есть что добавить к полилинии. добавим     -
	;;                                                                                        -
	;; если новые добавочные данные существуем, то дополним список точек (конец)              -
	;;                                                                                        -
	;; добавим данные в объект (конец)                                                        -
      )					; конец PROGN введены координаты                          -
      ;; введены координаты (конец)                                                               -
    )					; конец IF смотрим что ввели                              -
    ;; Проверим на "пустой ввод" (начало)                                                         -
  )					; конец WHILE организуем ввод точек до появления п. ввода -
;;;                                                                                               -
;;; Введем последующие точки (конец)                                                              -
;;;                                                                                               -



;;;                                                                                               -
;;; Расстановка точек соединений (конец)                                                          -
;;;                                                                                               -
  (if (/= protype 7)			; если мы нарисовали не кабель                            -
    (command (pr-soedinenie-01 mainpolyname)) ;_ то расставить точки соединения                   -
  )					; если мы нарисовали не кабель                            -
;;;                                                                                               -
;;; Расстановка точек соединений (конец)                                                          -
;;;                                                                                               -



;;;                                                                                               -
;;; Восстановление системных переменных (начало)                                                  -
;;;                                                                                               -
  (setvar "clayer" oldclayer)		; Восстановить слой                                       -
  (setvar "cecolor" oldcecolor)		; Восстановить текущий цвет рисования                     -
  (setvar "celtype" oldceltype)		; Восстановить тип линии                                  -
  (setvar "snapmode" oldsnapmode)	; Сохранить текущее состояние шага (вкл/выкл)             -
  (setvar "osmode" oldosmode)		; Сохранить текущий тип привязки                          -
  (setvar "gridmode" oldgridmode)	; Восстановить состояние сетки                            -
  (setvar "cmdecho" oldcmdecho)		; Восстановить значения переменной "cmdecho"              -
;;;                                                                                               -
;;; Восстановление системных переменных (конец)                                                   -
;;;                                                                                               -



) ;_ defun конец


;;;   *********************************************************************************************
;;;   *                                                                                           *
;;;   *                           Функция отрисовки проводников                                   *
;;;   *                                        (конец)                                            *
;;;   *                                                                                           *
;;;   *********************************************************************************************

Диалог к нему:

Код:

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

 
// **************************************************************
// *          Окно выбора типа проводника (начало)              *
// **************************************************************
provod1:dialog {label="Рисование прводника";
:spacer{width=0;height=1;}
:text{label="Выберите тип проводника";alignment=centered;}
:spacer{width=0;height=1;}
:row{
:column{label="Переменный ток";
:button{label="  220 Фаза  ";key="b11";width=12;}
:button{label="220 Нейтраль";key="b12";width=12;}
:spacer{width=0;height=2;}
}// конец COLUMN
:spacer{width=1;height=0;}
:column{label="Постоянный ток";
:button{label="    + 24    ";key="b21";width=16;}
:button{label="    - 24    ";key="b22";width=12;}
:spacer{width=0;height=2;}
}// конец COLUMN
:spacer{width=1;height=0;}
:column{label="Другое";
:button{label="Неопределено";key="b31";width=12;}
:button{label="   Земля    ";key="b32";width=12;}
:button{label="   Кабель   ";key="b33";width=12;}


}// конец COLUMN
}// конец ROW
:spacer{width=0;height=1;}
cancel_button;
}
// **************************************************************
// *          Окно выбора типа проводника (конец)               *
// **************************************************************

Nike · 12.05.2012, 13:56

Main Urod, это мегакруто!

А что еще крутого есть?

Nikolay 2 · 07.02.2015, 15:13

Почему-то DCL не подгружается, файл sapr_provodniki.DCL лежит в папке с lisp, вот листинг:

Команда: _appload pr-make.lsp успешно загружено.

Команда:
Команда:
Команда: _pr-make

Функция прорисовки проводников
Файл sapr_provodniki.DCL не найден

<< Принудительное завершение работы программы >>
Error: завершить / выйти прервать
Команда:

AutoCAD 2008 - Русский SP1
просьба помочь, что не так делаю?...

Разобрался, пришлось заново прописать путь к папке файлов поддержки. Видимо какой-то сбой произошел когда прописывал в первый раз.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Создание нового типа линий	Apelsinov	AutoCAD	915	08.07.2022 12:36
Несплошные линии, X-refы и... задача	Vova	AutoCAD	6	20.04.2018 16:14
Осевые и штрихпунктирные линии (вывод на печать)	Klop	AutoCAD	3	09.01.2008 11:45
Как сгладить 2 линии. Или как сгладить только часть линии.	Димас	AutoCAD	3	14.03.2006 08:28
Загрузка типа линии из макроса	Кулик Алексей aka kpblc	Программирование	4	24.01.2005 14:57

30.04.2012, 10:09
Линии электрических соединений Shoorup Минск Регистрация: 16.09.2006 Сообщений: 1,587 Прошу помощи в реализации идеи создании линии электрического соединения. Суть такая, что нужно рисовать две линии - одну горизонтально и от нее сразу вертикальную без нажатия Enter. Нечто подобное есть в AutoCAD Electrical. Хочется немного расширить/улучшить возможность рисования таких линий. Более подробно: 1. Линии рисуются только ортогонально. 2. Первая линия может быть как вертикальная так и горизонтальная. 3. Начало второй линии должно начаться автоматически как только курсор выйдет за пределы X или Y. т.е. например рисуем сначала горизонтальную линию. Тыкаем начальную точку, затем ведем в сторону на некоторое произвольное расстояние, останавливаемся, тянем курсор в верх или низ, выходим за предел Y и начинает рисоваться уже вертикальная линия. Завершаем тыком или по той же схеме продолжаем рисовать "змейку". Вообще такое возможно то хоть реализовать в AutoCAD? __________________ Поезд который устал от ржавого здравомыслия рельсов...
Просмотров: 19293