LISP. Как создать 2D трубопровод (3 параллельные линии)?

bboysyndrom · 14.06.2016, 12:29

Как прорисовать трубопровод (3 параллельные линии) указанием начала и конца?
Возникает ошибка, помогите найти.
Предложения более грамотного кода приветствуется.

Код:

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

 (defun c:c_pipe (/ p1 p2 p3 p4 p5 p6 diam) ;
	(setq p1 (getpoint "\nНачальная : ")) ;
	(setq p2 (getpoint "\nКонечная : ")) ;
  	(command "_line" p1 p2 "")
	(setq diam (getreal "\nДиаметр : ")) ;
	(setq p3 (polar p1 (+ angle( p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p4 (polar p2 (+ angle( p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p5 (polar p1 (* pi 1.5 ) (/ diam 2 )))
	(setq p6 (polar p1 (* pi 1.5 ) (/ diam 2 )))
	(setq osm (getvar "osmode")) ;
	(setvar "osmode" 0) ;
	(command "_line" p1 p2 "")
	(command "_line" p3 p4 "")
	(command "_line" p5 p6 "")
	(setvar "osmode" osm) ;
) ;

Krieger · 14.06.2016, 13:15

Не верно написана функция angle, скобка стоит апосля, а не перед функцией.
p5=p6
Перед отрисовкой примитивов через command желательно отключать привязки.
Я бы сделал мультилиниями.

Puroshev · 14.06.2016, 13:34

Держи исправленный LISP, но для этого лучше использовать, как сказал Krieger мультилинии.

Код:

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

  (defun c:c_pipe  (/ p1 p2 p3 p4 p5 p6 diam) ;
        (setq osm (getvar "osmode"))
        (setvar "osmode" 0) ;
	(setq p1 (getpoint "\nНачальная : ")) ;
	(setq p2 (getpoint P1 "\nКонечная : ")) ;
  	(command "_line" p1 p2 "")
	(setq diam (getreal "\nДиаметр : ")) ;
	(setq p3 (polar p1 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p4 (polar p2 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))

   	(setq p5 (polar p1 (+ (angle p1 p2) (/ pi -2 )) (/ diam 2 )))
	(setq p6 (polar p2 (+ (angle p1 p2) (/ pi -2 )) (/ diam 2 )))

	;(setq p5 (polar p1 (* pi 1.5 ) (/ diam 2 )))
	;(setq p6 (polar p1 (* pi 1.5 ) (/ diam 2 )))
	(setq osm (getvar "osmode")) ;
	(setvar "osmode" 0) ;
	(command "_line" p1 p2 "")
	(command "_line" p3 p4 "")
	(command "_line" p5 p6 "")
	(setvar "osmode" osm) ;
) ;

bboysyndrom · 14.06.2016, 13:38

Поправил.

Код:

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

 (defun c:c_pipe (/ p1 p2 p3 p4 p5 p6 diam) ;
	(setq p1 (getpoint "\nНачальная : ")) ;
	(setq p2 (getpoint "\nКонечная : ")) ;
  	(setq diam (getreal "\nДиаметр : ")) ;
	(setq p3 (polar p1 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p4 (polar p2 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p5 (polar p1 (+ (angle p1 p2) (* pi 1.5 ) ) (/ diam 2 )))
	(setq p6 (polar p2 (+ (angle p1 p2) (* pi 1.5 ) ) (/ diam 2 )))
	(setq osm (getvar "osmode")) ;
	(setvar "osmode" 0) ;
	(command "_line" p1 p2 "")
	(command "_line" p3 p4 "")
	(command "_line" p5 p6 "")
	(setvar "osmode" osm) ;
) ;

Подскажите, как средней линии присвоить цвет 11?

Puroshev · 14.06.2016, 13:48

Код:

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

  (defun c:c_pipe  (/ p1 p2 p3 p4 p5 p6 diam) ;
        (setq osm (getvar "osmode"))
        (setq col (getvar "CeColor"))

	(setq p1 (getpoint "\nНачальная : ")) ;
	(setq p2 (getpoint P1 "\nКонечная : ")) ;
   
           (setvar "osmode" 0) ;
           (setvar "CeColor" "11") ; устанавливаем цвет
	   (command "_line" p1 p2 "")
           (setvar "cecolor" col) ; возвращаем цвет
   
	(setq diam (getreal "\nДиаметр : ")) ;
	(setq p3 (polar p1 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))
	(setq p4 (polar p2 (+ (angle p1 p2) (/ pi 2 )) (/ diam 2 )))

   	(setq p5 (polar p1 (+ (angle p1 p2) (/ pi -2 )) (/ diam 2 )))
	(setq p6 (polar p2 (+ (angle p1 p2) (/ pi -2 )) (/ diam 2 )))

	(command "_line" p3 p4 "")
	(command "_line" p5 p6 "")
	(setvar "osmode" osm) ;

) ;

bboysyndrom · 14.06.2016, 13:49

Offtop: Мультилинии, мое мнение, инструмент который заброшен и не развивается вообще. Больше проблем, чем удобств (чего только стоит отсутствие привязок при обрезке). Пробовал ими трубопроводы проектировать - дело не пошло.
Дин. блоками тоже есть свои минусы. Видел плагины TSVTECH PipeFitPro, Procad ORTHO. Захотелось попробовать создать подобное.

kacugu · 14.06.2016, 13:53

Цитата:

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

Дин. блоками тоже есть свои минусы.

Offtop: а отводы, переходы и подобное как планируете чертить?

bboysyndrom · 14.06.2016, 13:54

Код:

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

 (setvar "cecolor" col) ; возвращаем цвет

ошибка: Настройка переменной AutoCAD отвергнута: "CeColor" nil
Цвет ПоСлою имеет какое-то значение?

----- добавлено через ~3 мин. -----

Цитата:

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

Offtop: а отводы, переходы и подобное как планируете чертить?

Offtop: Вот потихоньку к этому хотел прийти. Есть ли в LISP возможность создавать таблицы размеров, или ссылаться на файлы, где есть шаблоны элементов в виде примитивов и т.п.?

----- добавлено через ~5 мин. -----
Возможно в LISP включать предпросмотр во время указания второй точки, как при обычном построении отрезков?

Puroshev · 14.06.2016, 14:02

bboysyndrom

ты копировал LISP c поста #5 ? Цвет ПоСлою имеет какое-то значения не имеет.

Krieger · 14.06.2016, 14:04

Цитата:

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

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

Вот тут то и помогут мультилинии.
Лови прогу с мультилиниями.

Код:

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

(defun c:kr_pipe (/ d1)
  (setq mscale (getvar "CMLSCALE"))
 (if (setq d1 (getreal "\nДиаметр: "))
   (progn
     (Kr_AddMlineStyle (list
			 (cons (/ d1 -2) '(5 "CONTINUOS"))
			 '(0 5 "CONTINUOS")
			 (cons (/ d1 2) '(5 "CONTINUOS"))) "PIPE")
   (setvar "CMLSTYLE" "PIPE")
   (setvar "CMLSCALE" 1)
   (command "_mline")
   (setvar "CMLSCALE" mscale)
     )
   );if
  );


;|=======================================================================================================
Функция Kr_DelMlineStyle
Функция удаляет стиль мультилинии
Работает даже если необходимый стиль установлен текущим, но не работает если в чертеже имеются млинии этого стиля.
Параметры:
StyleName - название стиля
===========================================================================================================|;

(defun Kr_DelMlineStyle (StyleName / mlDict mlList)
(if (= (getvar "CMLSTYLE") StyleName)
(progn
    (if (= nil
     (member '(3 . "STANDARD") (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))    ;если стиля "STANDARD" нет - создадим его
      )
  (progn
    (setq mlDict
         (cdr (assoc -1
             (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
          )
         )
      )
      (setq mlList (list
             '(0 . "MLINESTYLE")
             '(102 . "{ACAD_REACTORS")
             '(102 . "}")
             '(100 . "AcDbMlineStyle")
             '(2 . "STANDARD")
             '(3 . "")
             '(62 . 256)
             '(51 . 1.5708)
             '(52 . 1.5708)
             '(71 . 2)
             '(49 . -0.5)
             '(62 . 0)
             '(6 . "BYLAYER")
             '(49 . 0.5)
             '(62 . 0)
             '(6 . "BYLAYER")             
            );end list
      ); end setq 
    (dictadd mlDict "STANDARD" (entmakex mlList))
    );end progn
  );end if
  (setvar "CMLSTYLE" "STANDARD");и сделаем текущим
  );end progn
  );end if
;если он в словаре типов мультилиний есть - удаляем нафиг:
  (if (/= nil
     (member (cons 3 StyleName) (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
      )
  (vl-cmdf "_-purge" "_Mlinestyles" StyleName "n");собсно эта строчка и удаляет
  );end if

  );end defun
;|=======================================================================================================
Функция Kr_AddMlineStyle
Создаёт стиль мультилиний. Стили с такими-же именами удаляются (функцией Kr_DelMlineStyle) и вместно нее создается новый стиль.
Типы линий загружаются сами (должны быть прописаны в путях поддержки).
Параметры:
ListParam - список параметров вида: ((a aColor aLineType)(b aColor bLineType).. и т.д. ..(N NColor NLineType)), где
    a, b, ... , N - расстояния от цетра млинии до каждой её линии
    aColor и т.д. - цвета линии млинии
    aLineType и т.д. - тип линий в стиле млиний
StyleName - имя стиля млиний ("УКАЗЫВАТЬ В КАВЫЧКАХ И ЗАГЛАВНЫМИ БУКВАМИ!")
Примеры:
(Kr_AddMlineStyle (list '(-20 5 "CONTINUOS") '(-7 26 "ACAD_ISO03W100") '(7 26 "ACAD_ISO03W100") '(20 5 "CONTINUOS")) "PROBA")
=======================================================================================================|;
(defun Kr_AddMlineStyle    (ListParam StyleName / nn n mlDict mlList mlListadd)

(setq n (length ListParam))
  
(Kr_DelMlineStyle StyleName)
  
      (setq mlDict
         (cdr (assoc -1
             (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
          )
         )
      )
      (setq mlList (list
             '(0 . "MLINESTYLE")
             '(102 . "{ACAD_REACTORS")
             '(102 . "}")
             '(100 . "AcDbMlineStyle")
             (cons 2 StyleName)
             '(70 . 272)
             '(3 . "")
             '(62 . 256)
             '(51 . 1.5708)
             '(52 . 1.5708)
             (cons 71 n)
           );end list
      )                    ; end setq             

  (foreach NN ListParam
    (Progn
    (Setq mlListadd
           (list
            (cons 49 (car NN))
                  (cons 62 (cadr NN))
            (cons 6 (caddr NN))
            )
          mlList    (append mlList mlListadd)
    );end setq
      );end progn
    );end foreach
      
      (dictadd mlDict StyleName (entmakex mlList))
)

kacugu · 14.06.2016, 14:16

Цитата:

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

Вот потихоньку к этому хотел прийти.

Offtop: посмотрите http://acad-prog.ru/avtomatizatsiya-...ovaniya-otvod/ - может будут полезные идеи

----- добавлено через ~10 мин. -----

Цитата:

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

Лови прогу с мультилиниями.

В 2015 автокаде при повторном вызове команды выдаёт ошибку в строке (command "_mline"). Видимо надо заменить на (command-s "_mline"). Но тогда не меняется "диаметр" мультилинии.

Krieger · 14.06.2016, 14:41

Цитата:

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

Offtop: посмотрите http://acad-prog.ru/avtomatizatsiya-...ovaniya-otvod/ - может будут полезные идеи

----- добавлено через ~10 мин. -----

В 2015 автокаде при повторном вызове команды выдаёт ошибку в строке (command "_mline"). Видимо надо заменить на (command-s "_mline"). Но тогда не меняется "диаметр" мультилинии.

Ну про command-s не скажу, я пока на 2014 застрял.

А вот с диаметром косяк, стиль не удаляется если есть линии с этим стилем в чертеже, поэтому их придется расчленять, либо создавать новый стиль с новым диаметром. Вот вариант с расчленением.

Код:

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

(defun c:kr_pipe (/ d1)
  (setq mscale (getvar "CMLSCALE"))
 (if (setq d1 (getreal "\nДиаметр: "))
   (progn
     (Kr_AddMlineStyle (list
			 (cons (/ d1 -2) '(5 "CONTINUOS"))
			 '(0 5 "CONTINUOS")
			 (cons (/ d1 2) '(5 "CONTINUOS"))) "PIPE")
   (setvar "CMLSTYLE" "PIPE")
   (setvar "CMLSCALE" 1)
   (command "_mline" pause)
     (while (/= (logand (getvar "cmdactive") 31) 0)
		    (command pause)
		);while
   (setvar "CMLSCALE" mscale)
   (command "explode" "_L" "")
     )
   );if
  );


;|=======================================================================================================
Функция Kr_DelMlineStyle
Функция удаляет стиль мультилинии
Работает даже если необходимый стиль установлен текущим, но не работает если в чертеже имеются млинии этого стиля.
Параметры:
StyleName - название стиля
===========================================================================================================|;

(defun Kr_DelMlineStyle (StyleName / mlDict mlList)
(if (= (getvar "CMLSTYLE") StyleName)
(progn
    (if (= nil
     (member '(3 . "STANDARD") (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))    ;если стиля "STANDARD" нет - создадим его
      )
  (progn
    (setq mlDict
         (cdr (assoc -1
             (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
          )
         )
      )
      (setq mlList (list
             '(0 . "MLINESTYLE")
             '(102 . "{ACAD_REACTORS")
             '(102 . "}")
             '(100 . "AcDbMlineStyle")
             '(2 . "STANDARD")
             '(3 . "")
             '(62 . 256)
             '(51 . 1.5708)
             '(52 . 1.5708)
             '(71 . 2)
             '(49 . -0.5)
             '(62 . 0)
             '(6 . "BYLAYER")
             '(49 . 0.5)
             '(62 . 0)
             '(6 . "BYLAYER")             
            );end list
      ); end setq 
    (dictadd mlDict "STANDARD" (entmakex mlList))
    );end progn
  );end if
  (setvar "CMLSTYLE" "STANDARD");и сделаем текущим
  );end progn
  );end if
;если он в словаре типов мультилиний есть - удаляем нафиг:
  (if (/= nil
     (member (cons 3 StyleName) (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
      )
  (vl-cmdf "_-purge" "_Mlinestyles" StyleName "n");собсно эта строчка и удаляет
  );end if

  );end defun
;|=======================================================================================================
Функция Kr_AddMlineStyle
Создаёт стиль мультилиний. Стили с такими-же именами удаляются (функцией Kr_DelMlineStyle) и вместно нее создается новый стиль.
Типы линий загружаются сами (должны быть прописаны в путях поддержки).
Параметры:
ListParam - список параметров вида: ((a aColor aLineType)(b aColor bLineType).. и т.д. ..(N NColor NLineType)), где
    a, b, ... , N - расстояния от цетра млинии до каждой её линии
    aColor и т.д. - цвета линии млинии
    aLineType и т.д. - тип линий в стиле млиний
StyleName - имя стиля млиний ("УКАЗЫВАТЬ В КАВЫЧКАХ И ЗАГЛАВНЫМИ БУКВАМИ!")
Примеры:
(Kr_AddMlineStyle (list '(-20 5 "CONTINUOS") '(-7 26 "ACAD_ISO03W100") '(7 26 "ACAD_ISO03W100") '(20 5 "CONTINUOS")) "PROBA")
=======================================================================================================|;
(defun Kr_AddMlineStyle    (ListParam StyleName / nn n mlDict mlList mlListadd)

(setq n (length ListParam))
  
(Kr_DelMlineStyle StyleName)
  
      (setq mlDict
         (cdr (assoc -1
             (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
          )
         )
      )
      (setq mlList (list
             '(0 . "MLINESTYLE")
             '(102 . "{ACAD_REACTORS")
             '(102 . "}")
             '(100 . "AcDbMlineStyle")
             (cons 2 StyleName)
             '(70 . 272)
             '(3 . "")
             '(62 . 256)
             '(51 . 1.5708)
             '(52 . 1.5708)
             (cons 71 n)
           );end list
      )                    ; end setq             

  (foreach NN ListParam
    (Progn
    (Setq mlListadd
           (list
            (cons 49 (car NN))
                  (cons 62 (cadr NN))
            (cons 6 (caddr NN))
            )
          mlList    (append mlList mlListadd)
    );end setq
      );end progn
    );end foreach
      
      (dictadd mlDict StyleName (entmakex mlList))
)

Do$ · 14.06.2016, 15:12

Цитата:

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

Цвет ПоСлою имеет какое-то значение?

256 - по слою
0 - по блоку

kacugu · 14.06.2016, 15:19

Цитата:

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

(command "explode" "_L")

нужно исправить на (command "_explode" "_L" "")
Offtop: а почему создавали именно стиль "pipe", а не "pipi_d1" - т.е. для каждого диаметра свой стиль?

bboysyndrom · 14.06.2016, 15:42

Повторюсь: Возможно в LISP включать предпросмотр во время указания второй точки, как при обычном построении отрезков? Причем всех трех отрезков.
Offtop: Я все же хочу с помощью примитивов все сделать.

Profan · 14.06.2016, 17:54

Цитата:

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

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

Посмотри описание функции (initget).

Do$ · 14.06.2016, 22:34

Цитата:

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

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

В чистом лиспе - см. GRREAD. Кое-что можно сделать с помощью нее, но очень сложно получить именно то, что нужно.
А еще есть отличное ARX-приложение, добавляющее функционал динамического рисования в лисп - DynDraw от Александра Ривилиса. Есть тут: http://www.maestrogroup.com.ua/support/. Если разберетесь, как это работает, то лучше вариант вряд ли найдете.

Krieger · 15.06.2016, 05:37

Цитата:

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

Offtop: а почему создавали именно стиль "pipe", а не "pipi_d1" - т.е. для каждого диаметра свой стиль?

Ну я же писал, что можно сделать и так и эдак, зависит от конкретных задач. В свое время заморачивался с мультилиниями для отрисовки профилей проката. Так мультилинии были нужны, только для визуализации вычерчивания (вместо grread), потом она удалялась и заменялась на блоки. И чтобы не плодить мусор в чертеже под все профиля стиль мультилинии создаётся временный, на один раз.
В данном случае под трубы можно и наплодить стилей, не проблема.

Цитата:

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

А я что делаю?

Цитата:

Я все же хочу с помощью примитивов все сделать.

Отрисовываешь мультилинией для визуализации, получаешь список её координат, удаляешь мультилинию, и по этим координатам по новой делаешь все отрезками.

Цитата:

Сообщение от Do$

А еще есть отличное ARX-приложение, добавляющее функционал динамического рисования в лисп - DynDraw от Александра Ривилиса.

Давно смотрел этот DynDraw, могу ошибаться, но там вроде бы привязки при отрисовке не работают.

Цитата:

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

Посмотри описание функции (initget).

При чем тут initget?

Do$ · 15.06.2016, 11:02

Цитата:

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

Давно смотрел этот DynDraw, могу ошибаться, но там вроде бы привязки при отрисовке не работают.

Как раз-таки, в этом варианте привязки работают. Не работают, если GRREAD "в чистом виде" использовать. Правда, Елпанов Евгений этот вопрос решал, но код довольно сложный получается.
Видео работы привязок: https://knowledge.autodesk.com/commu...f-f00704400e1a

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как создать тип линии в автокаде с залитым кругом?	архиВерочка	Вертикальные решения на базе AutoCAD	2	22.05.2016 12:50
Как сменить и создать пунктирные линии на чертеже?	Vovanchik58	AutoCAD	5	30.06.2011 01:20
Создать тип линии	Kotsar	AutoCAD	1	10.07.2009 14:47
Как создать 2D проекцию 3D объекта?	MrKiLLER	AutoCAD	18	09.10.2008 17:25