LISP для построения ВЛ и ЛС в автокаде, возможно?

Gotch · 11.12.2014, 09:54

друзья пользовался поиском не нашел построение ЛЭП
возможно ли полностью автоматизировать вставку блоков стрелочек
4 вопроса перед построение:
1. Масштаб съемки: 0 - 500; 1 - 1000; 2 - 2000; 5 - 5000 (по умолчанию значение 1)
2. Территория: 1 - застроенная; 2 - незастроенная (на застроенной соединять плинией цветом 250; на незастроенной цвет черный)
3. Тип опоры: 1 - ж/б; 2 - метал; 3 - дерев
4. Тип ЛЭП: 1 - высоковольтная; 2 - низковольтная; 3 - связь
такой алгоритм -
- проводим для начала плинию, первый отрезок
- ставим на вершинах плинии блок опоры
- ставим на вершинах блок стрелок
- и относительно Базового угла Восток 0d00' поворачиваем на нужный угол что бы легли на плинию
такое возможно?
или не получиться настолько автоматизировать?
что бы как в кредомикс рисуешь и все сразу ставиться как надо
если такой лисп уже есть не пинайте сильно
помогите кому не сложно

прикрепил архив с блоками столбов и стрелок
столбы
B-STOLB-34.dwg - столб метал
B-STOLB-38.dwg - столб ж/б
B-STOLB-39.dwg - столб дерево
стрелки
B-VL-V.dwg - стрелка высоковольтная
B-VL-N.dwg - стрелка низковольтная
B-VL-S.dwg - стрелка связь

freese · 11.12.2014, 19:39

В exchange вот такое есть https://apps.exchange.autodesk.com/A...ws32and64%3aru

ShaggyDoc · 11.12.2014, 21:20

Разумеется, такую программу сделать можно. Тем более, что рисовать ВЛ решили не впервые в мире. И не надо никаких "динамических блоков", и "стрелочки доворачивать".
И не надо "слои поделим". Правильная программа всегда должна рисовать на текущем слое. В разных организациях могут быть свои стандарты слоев, цвета и прочего.

Если где-то есть стандартный слой для ВЛ (или всего прочего) то уже другая функция должна устанавливать такой слой, а рисование должно выпоняться "методом слоя", т.е. слой "знает" что и как на нем должно изображаться.

Ну, это не для данного случая. На картинке - меню со всеми видами электросетей, на другой - результат рисования некоторых ВЛ. Всё рисование сводится к выполнению протокола:
Первая точка [Образец/Начало]<Выход>: Указали
Следующая точка [Пред/Образец/Начало]<Выход>: Указали
Следующая точка [Пред/Образец/Начало]<Выход>: Указали
Следующая точка [Пред/Образец/Начало]<Выход>:П - выбрали опцию Пред. Теперь будут запрашиваться точка от предыдщего столба

Следующая точка [Пред/Образец/Начало]<Выход>: Указали и пошли от предыдущего столба в другую сторону.
Следующая точка [Пред/Образец/Начало]<Выход>: Указали
Следующая точка [Пред/Образец/Начало]<Выход>:О - выбрали опцию Образец

Выбери отрезок или полилинию <Выход>: - указали на полилинию. По всей трассе этой полилинии разоставились стобы со стрелками, повернутыми в нужном направлении.
Следующая точка [Пред/Образец/Начало]<Выход>: Нажали Enter и вышли.

В следующий раз можем продолжить от последней точки, выбрав опцию Пред.

Как всё это сделать - написано в книге "САПР на базе AutoCAD - как это делается". Там и исходники есть.

ciril · 12.12.2014, 14:31

Ну вот как-то так

Код:

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

 (defun aiku_copyblock  (e00 e01 / x00 x01)
    (vl-load-com)
    (and (vl-catch-all-error-p
             (setq x01 (vl-catch-all-apply 'vla-open
                                           (list (setq x00 (vla-getinterfaceobject (vlax-get-acad-object)
                                                                                   (strcat "ObjectDBX.AxDbDocument."
                                                                                           (if (>= (setq x00 (substr (getvar 'acadver) 1 2)) "16")
                                                                                               x00
                                                                                               ""))))
                                                 e00))))
         (vl-catch-all-error-message x01))
    (and (vl-catch-all-error-p
             (setq x01 (vl-catch-all-apply 'vla-copyobjects
                                           (list x00
                                                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0))
                                                                      (list (vla-item (vla-get-blocks x00) e01)))
                                                 (vla-get-blocks (vla-get-activedocument (vla-get-application (vlax-get-acad-object))))))))
         (vl-catch-all-error-message x01))
    (vlax-release-object x00))
(defun c:лэп  (/ x00 x01 x02 x03 x04 x05 x06 x07 la00 la01 xff)
    (mapcar 'set
            '(x00 x01 x02 x03)
            (if (eq "aiku" (car (setq x00 (read (getvar 'users1)))))
                (cdr x00)
                '("1000" "Застроенная" "Железобетонная" "Высоковольтная")))
    (setq xff (getvar 'users1))
    (mapcar (function
                (lambda (a00 a01 a02 / u00)
                    (initget a00)
                    (and (setq u00 (getkword (strcat "\nВведите " a02 " [" a00 "]: <" (eval a01) "> "))) (set a01 u00))))
            '("500 1000 2000 5000"
              "Застроенная Незастроенная"
              "Железобетонная Металлическая Деревянная"
              "Высоковольтная Низковольтная Связь")
            '(x00 x01 x02 x03)
            '("масштаб съемки" "тип территории" "тип опоры" "тип ЛЭП"))
    (setvar 'users1 (strcat "(\"aiku\"" x00 "\" \"" x01 "\" \"" x02 "\" \"" x03 "\")"))
    (setq x00  (/ (atoi x00) 1000.0)
          x00  (mapcar (function (lambda (a00) (cons a00 x00))) '(41 42 43))
          x01  (cons 62
                     (if (eq x01 "Застроенная")
                         8
                         250))
          x04  (cons 8
                     (cdr
                         (assoc (substr (caadr
                                            (mapcar (function
                                                        (lambda (a00 a01 / u00)
                                                            (or (tblobjname "BLOCK" (setq u00 (cdr (assoc (eval a00) a01))))
                                                                (aiku_copyblock (if (or x05 (setq x05 (findfile "Блоки.dwg")))
                                                                                    x05
                                                                                    (progn (while (not (setq x05 (getfiled "Файл блоков" "Блоки" "dwg" 0)))) x05))
                                                                                u00))
                                                            (set a00 (cons u00 (tblobjname "BLOCK" u00)))))
                                                    '(x02 x03)
                                                    '((("Железобетонная" . "B-STOLB-38") ("Металлическая" . "B-STOLB-34") ("Деревянная" . "B-STOLB-39"))
                                                      (("Высоковольтная" . "B-VL-V") ("Низковольтная" . "B-VL-N") ("Связь" . "B-VL-S")))))
                                        6)
                                '(("V" . "И1 ЛЭП ВЛ") ("N" . "И1 ЛЭП НЛ") ("S" . "И1 ЛЭП ЛС")))))
          la00 (function (lambda (a00) (entmake (append '((0 . "INSERT") (100 . "AcDbEntity") (62 . 0)) x00 a00)))))
    ((eval
         (setq la01 (function
                        (lambda (a00 a01 a02)
                            (and a01
                                 (progn (mapcar la00
                                                (list (list (cons 330 (cdr x02)) (cons 10 a00) (cons 8 "И1 ЛЭП") (cons 2 (car x02)) '(50 . 0.0))
                                                      (list (cons 330 (cdr x03)) (cons 10 a00) x04 (cons 2 (car x03)) (cons 50 (angle a00 a01)))
                                                      (list (cons 330 (cdr x03)) (cons 10 a01) x04 (cons 2 (car x03)) (cons 50 (angle a01 a00)))))
                                        (setq x07 (entmod (subst (cons 90 (1+ a02))
                                                                 (cons 90 a02)
                                                                 (append x07 (list (setq x06 (list 10 (car a01) (cadr a01)))))))))
                                 ((eval la01) a01 (getpoint "\nУкажите следующую точку или <завершить>: " a01) (1+ a02)))))))
        (setq x06 (getpoint "\nУкажите следующую точку: " (setq x05 (getpoint "\nУкажите начальную точку: "))))
        (progn (and x06
                    (setq x07 (entget
                                  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 2))
                                                    (mapcar (function (lambda (a00) (list 10 (car a00) (cadr a00)))) (list x05 x06))
                                                    (list x01 x04))))))
               (mapcar la00
                       (list (list (cons 330 (cdr x02)) (cons 10 x05) (cons 8 "И1 ЛЭП") (cons 2 (car x02)) '(50 . 0.0))
                             (list (cons 330 (cdr x03)) (cons 10 x05) x04 (cons 2 (car x03)) (cons 50 (angle x05 x06)))
                             (list (cons 330 (cdr x03)) (cons 10 x06) x04 (cons 2 (car x03)) (cons 50 (angle x06 x05)))))
               (setq x05 nil)
               (getpoint "\nУкажите следующую точку или <завершить>: " x06))
        2)
    (entmake (append '((0 . "INSERT") (100 . "AcDbEntity") (50 . 0.0) (62 . 0))
                     x00
                     (list (cons 330 (cdr x02)) x06 (cons 8 "И1 ЛЭП") (cons 2 (car x02)))))
    (setvar 'users1 xff)
    (princ))
(princ "\nСтроит ЛЭП с опорами и проводами, вызывается ЛЭП")
(princ)

Смотри, как так ли

Ести файл с блоками находится в путях поддержки, то файл с ними не запрашивает, ответы на запросы по типу ЛЭП сохраняются до конца закрытия чертежа.

Gotch · 15.12.2014, 07:05

я подправил вот тут твой код -

Код:

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

            '("500/1000/2000/5000"
              "Застроенная/Незастроенная"
              "Железобетонная/Металлическая/Деревянная"
              "Высоковольтная/Низковольтная/Связь")

что бы легко и удобно было мышкой выбирать

но выбирая мышкой выдает вот такое

Код:

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

Команда:
Строит ЛЭП с опорами и проводами, вызывается ЛЭП
Команда:
Команда: (c:лэп)

Введите масштаб съемки [500/1000/2000/5000]: <1000> 1000

Неправильное ключевое слово.

Введите масштаб съемки [500/1000/2000/5000]: <1000> 500

Введите тип территории [Застроенная/Незастроенная]: <Застроенная> Н

Неправильное ключевое слово.

Введите тип территории [Застроенная/Незастроенная]: <Застроенная> Н

Неправильное ключевое слово.

Введите тип территории [Застроенная/Незастроенная]: <Застроенная> Н

Неправильное ключевое слово.

Введите тип территории [Застроенная/Незастроенная]: <Застроенная> Н

Неправильное ключевое слово.

Введите тип территории [Застроенная/Незастроенная]: <Застроенная> З

Введите тип опоры [Железобетонная/Металлическая/Деревянная]: <Железобетонная> М

Неправильное ключевое слово.

Введите тип опоры [Железобетонная/Металлическая/Деревянная]: <Железобетонная> М

Неправильное ключевое слово.

Введите тип опоры [Железобетонная/Металлическая/Деревянная]: <Железобетонная> Д

Неправильное ключевое слово.

Введите тип опоры [Железобетонная/Металлическая/Деревянная]: <Железобетонная> Ж

Введите тип ЛЭП [Высоковольтная/Низковольтная/Связь]: <Высоковольтная> Н

Неправильное ключевое слово.

Введите тип ЛЭП [Высоковольтная/Низковольтная/Связь]: <Высоковольтная> С

Неправильное ключевое слово.

Введите тип ЛЭП [Высоковольтная/Низковольтная/Связь]: <Высоковольтная> В
; ошибка: неверный тип аргумента: stringp nil

значение по умолчанию оно не должно быть до двоеточия?

ciril · 15.12.2014, 08:54

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

Под мышь не "/", а " / ", но лучше весь код копируй, я там еще поправил.

Код:

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

 (defun aiku_copyblock  (e00 e01 / x00 x01)
    (vl-load-com)
    (and (vl-catch-all-error-p
             (setq x01 (vl-catch-all-apply 'vla-open
                                           (list (setq x00 (vla-getinterfaceobject (vlax-get-acad-object)
                                                                                   (strcat "ObjectDBX.AxDbDocument."
                                                                                           (if (>= (setq x00 (substr (getvar 'acadver) 1 2)) "16")
                                                                                               x00
                                                                                               ""))))
                                                 e00))))
         (vl-catch-all-error-message x01))
    (and (vl-catch-all-error-p
             (setq x01 (vl-catch-all-apply 'vla-copyobjects
                                           (list x00
                                                 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0))
                                                                      (list (vla-item (vla-get-blocks x00) e01)))
                                                 (vla-get-blocks (vla-get-activedocument (vla-get-application (vlax-get-acad-object))))))))
         (vl-catch-all-error-message x01))
    (vlax-release-object x00))
(defun c:лэп  (/ x00 x01 x02 x03 x04 x05 x06 x07 la00 la01 xff)
    (mapcar 'set
            '(x00 x01 x02 x03)
            (if (and (listp (setq x00 (read (getvar 'users1)))) (eq "aiku" (car x00)))
                (cdr x00)
                '("1000" "Застроенная" "Железобетонная" "Высоковольтная")))
    (mapcar (function
                (lambda (a00 a01 a02 / u00)
                    (initget a00)
                    (and (setq u00 (getkword (strcat "\nВведите " a02 " [" a00 "]: <" (eval a01) "> "))) (set a01 u00))))
            '("500 / 1000 / 2000 / 5000"
              "Застроенная / Незастроенная"
              "Железобетонная / Металлическая / Деревянная"
              "Высоковольтная / Низковольтная / Связь")
            '(x00 x01 x02 x03)
            '("масштаб съемки" "тип территории" "тип опоры" "тип ЛЭП"))
    (setvar 'users1 (strcat "(\"aiku\" \"" x00 "\" \"" x01 "\" \"" x02 "\" \"" x03 "\")"))
    (setq x00  (/ (atoi x00) 1000.0)
          x00  (mapcar (function (lambda (a00) (cons a00 x00))) '(41 42 43))
          x01  (cons 62
                     (if (eq x01 "Застроенная")
                         8
                         250))
          x04  (cons 8
                     (cdr
                         (assoc (substr (caadr
                                            (mapcar (function
                                                        (lambda (a00 a01 / u00)
                                                            (or (tblobjname "BLOCK" (setq u00 (cdr (assoc (eval a00) a01))))
                                                                (aiku_copyblock (if (or x05 (setq x05 (findfile "Блоки.dwg")))
                                                                                    x05
                                                                                    (progn (while (not (setq x05 (getfiled "Файл блоков" "Блоки" "dwg" 0)))) x05))
                                                                                u00))
                                                            (set a00 (cons u00 (tblobjname "BLOCK" u00)))))
                                                    '(x02 x03)
                                                    '((("Железобетонная" . "B-STOLB-38") ("Металлическая" . "B-STOLB-34") ("Деревянная" . "B-STOLB-39"))
                                                      (("Высоковольтная" . "B-VL-V") ("Низковольтная" . "B-VL-N") ("Связь" . "B-VL-S")))))
                                        6)
                                '(("V" . "И1 ЛЭП ВЛ") ("N" . "И1 ЛЭП НЛ") ("S" . "И1 ЛЭП ЛС")))))
          la00 (function (lambda (a00) (entmake (append '((0 . "INSERT") (100 . "AcDbEntity") (62 . 0)) x00 a00)))))
    ((eval
         (setq la01 (function
                        (lambda (a00 a01 a02)
                            (and a01
                                 (progn (mapcar la00
                                                (list (list (cons 330 (cdr x02)) (cons 10 a00) (cons 8 "И1 ЛЭП") (cons 2 (car x02)) '(50 . 0.0))
                                                      (list (cons 330 (cdr x03)) (cons 10 a00) x04 (cons 2 (car x03)) (cons 50 (angle a00 a01)))
                                                      (list (cons 330 (cdr x03)) (cons 10 a01) x04 (cons 2 (car x03)) (cons 50 (angle a01 a00)))))
                                        (setq x07 (entmod (subst (cons 90 (1+ a02))
                                                                 (cons 90 a02)
                                                                 (append x07 (list (setq x06 (list 10 (car a01) (cadr a01)))))))))
                                 ((eval la01) a01 (getpoint "\nУкажите следующую точку или <завершить>: " a01) (1+ a02)))))))
        (setq x06 (getpoint "\nУкажите следующую точку: " (setq x05 (getpoint "\nУкажите начальную точку: "))))
        (progn (and x06
                    (setq x07 (entget
                                  (entmakex (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 2))
                                                    (mapcar (function (lambda (a00) (list 10 (car a00) (cadr a00)))) (list x05 x06))
                                                    (list x01 x04))))))
               (mapcar la00
                       (list (list (cons 330 (cdr x02)) (cons 10 x05) (cons 8 "И1 ЛЭП") (cons 2 (car x02)) '(50 . 0.0))
                             (list (cons 330 (cdr x03)) (cons 10 x05) x04 (cons 2 (car x03)) (cons 50 (angle x05 x06)))
                             (list (cons 330 (cdr x03)) (cons 10 x06) x04 (cons 2 (car x03)) (cons 50 (angle x06 x05)))))
               (setq x05 nil)
               (getpoint "\nУкажите следующую точку или <завершить>: " x06))
        2)
    (entmake (append '((0 . "INSERT") (100 . "AcDbEntity") (50 . 0.0) (62 . 0))
                     x00
                     (list (cons 330 (cdr x02)) x06 (cons 8 "И1 ЛЭП") (cons 2 (car x02)))))
    (princ))
(princ "\nСтроит ЛЭП с опорами и проводами, вызывается ЛЭП")
(princ)

Gotch · 15.12.2014, 09:20

отлично все работает
спасибо огромное
напиши в личке куда денежку отправить

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Доработать программу построения 2d из 3d	vavII	LISP	2	29.09.2010 20:56
LISP для построения поперечных сечений	voverrr	LISP	5	31.03.2010 14:01
Программа для построения фермы в автокаде	dextron3	Прочее. Программное обеспечение	20	03.02.2010 15:36
скрытые возможности: автомат построения уклонов в АвтоКАДе	kiber_tech	AutoCAD	3	28.05.2009 15:14