Макрос на "обрыв" трубы.

Макрос на "обрыв" трубы. · 30.10.2007, 09:22

Добрый день.

Помогите отредактировать макрос который предлагает В.Свет или поделитесь своим вариантом.
Вариант MechaniCS мне как-то не очень.

Автокад 2006-русский.

^C^C'_Cal;P1=Cur;_Nea;\P2=Cur;_Per;\_Pline; '_Cal;P1;_W;0; ;_Ar;_Ang;70; '_Cal;P3=(P1+P2)/2; '_Cal;P2;_Ang;-70; '_Cal;P3; ;

Кулик Алексей aka kpblc · 30.10.2007, 09:33

http://dwg.ru/f/showthread.php?t=132...E1%F0%FB%E2%E0
http://dwg.ru/f/showthread.php?t=655...E1%F0%FB%E2%E0
Поиск однако

vic153 · 30.10.2007, 09:43

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

Код:

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

;|==============================================================================
*	Функция рисует линию разрыва трубы в виде полувосьмёрки
*	
*	Параметры вызова:
*
*	Пример вызова:
*	c:vic153-draw-breakline-pipe
===============================================================================|;
(defun c:vic153-draw-breakline-pipe ( /
				     old_ortho old_snap old_osnap old_autosnap old_angbase
				     pt1 pt2 pt3 ang_pt
				     reply)
   ;;Запоминаем текущие состояния режимов ORTO, SNAP, OSNAP, ANGBASE
  (setq old_ortho (getvar "ORTHOMODE")
	old_snap (getvar "SNAPMODE")
	old_osnap (getvar "OSMODE")
	old_autosnap (getvar "AUTOSNAP")
	old_angbase (getvar "ANGBASE")
	) ;_end of setq
  (prompt "\nФункция рисует линию разрыва трубы в виде полувосьмерки")
  (if (and (setq pt1 (getpoint "\nУкажите первую точку линии разрыва трубы:"))
	   (setq pt2 (getpoint pt1 "\nУкажите последную точку линии разрыва трубы:"))
	   ) ;_end of and
    (progn
      ;;Подавляем эхо
      (setvar "CMDECHO" 0)
      ;;Обнуляем режимы ORTO, SNAP, OSNAP
      (setvar "ORTHOMODE" 0)
      (setvar "SNAPMODE" 0)
      (setvar "OSMODE" 0)
      (setvar "AUTOSNAP" 0)
      ;;Расчитываем координаты средней точки и угол наклона прямой от pt1 до pt2
      (setq pt3 (list (/ (+ (car pt1) (car pt2)) 2.0)
		      (/ (+ (cadr pt1) (cadr pt2)) 2.0)
		      ) ;_end of list
	    ang_pt (angle pt1 pt2)
	    ) ;_end of setq
      (setvar "ANGBASE" ang_pt) ;устанавливаем новое направление угла 0 градусов в текущей ПСК
      ;;Запрашиваем направление оставшейся трубы
      (initget 1 "Right Left")
      (setq reply (getkword "\nКакая часть трубы остается [Right/Left]:"))
      (cond
	((eq reply "Right")
	;;Рисуем линию разрыва трубы в виде полувосьмерки полилинией
	(vl-cmdf "_.PLINE" pt1 "_arc" "_angle" 70.0 pt3 pt2 "_angle" -70.0 pt3 "")
	 ) ;_end of Right
	((eq reply "Left")
	 ;;Рисуем линию разрыва трубы в виде полувосьмерки полилинией
	 (vl-cmdf "_.PLINE" pt1 "_arc" "angle" -70.0 pt3 pt2 "_angle" 70.0 pt3 "")
	 ) ;_end of Left
	) ;_end of cond
      ;;Восстанавливаем состояния режимов ORTO, SNAP, OSNAP, ANGBASE
      (setvar "ORTHOMODE" old_ortho)
      (setvar "SNAPMODE" old_snap)
      (setvar "OSMODE" old_osnap)
      (setvar "AUTOSNAP" old_autosnap)
      (setvar "ANGBASE" old_angbase)
      ;;Включаем эхо
      (setvar "CMDECHO" 1)
      ) ;_end of progn
    (exit)
    ) ;_end of if
  (princ)
  ) ;_end of defun

30.10.2007, 10:39

Спасибо за оба отзыва.

Вопрос по запуску (загрузке)
Коды сохранил в *.LSP.Пытаюсь загрузить 2-мя способами:

1.Из редактора лиспа->; 1 блок кода загружено из #<editor "C:/Program Files/AutoCAD 2006/Support/Обрыв трубы.LSP"> ->перехожу в графический редактор Автокада.

2.В командной строке вписываю адрес файла *.LSP

В чём моя ошибка?

Кулик Алексей aka kpblc · 30.10.2007, 10:48

Для последнего варианта надо вбивать в ком.строке

Код:

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

Command: vic153-draw-breakline-pipe

30.10.2007, 10:51

->Кулик Алексей aka kpblc

Пробовал конечноже-ни в какую.

Express Tols как-нибудь влияет в общем на работу макросов и доп.приложений?

30.10.2007, 11:04

->Кулик Алексей aka kpblc

Опа.Извиняюсь.Всё в парядке.

Кулик Алексей aka kpblc · 30.10.2007, 11:15

Странно, у меня все сработало. На всякий случай (уж очень сильно не хочу работать) еще вариант:

Код:

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

(defun c:round-break (/ *error* adoc start_pt end_pt dir tg mid)
  ;|
*    Функция отрисовки фигурного обрыва линии (трубы) с попыткой динамичексой
* отрисовки
*    Автор: Кулик Алексей aka kpblc
*    Опубликовано 30 окт.2007 http://dwg.ru/f/showthread.php?p=179558
|;
  (defun *error* (msg)
    (redraw)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (= (type (setq
                 start_pt (vl-catch-all-apply
                            '(lambda ()
                               (getpoint "\nНачальная точка обрыва <Отмена> : ")
                               ) ;_ end of lambda
                            ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      start_pt
      (= (type (setq end_pt (vl-catch-all-apply
                              '(lambda ()
                                 (getpoint start_pt
                                           "\nКонечная точка обрыва <Отмена> : "
                                           ) ;_ end of getpoint
                                 ) ;_ end of lambda
                              ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      end_pt
      (= (type (setq dir
                      (vl-catch-all-apply
                        '(lambda ()
                           (grdraw start_pt end_pt 7)
                           (getpoint
                             (mapcar '(lambda (a b) (* 0.5 (+ a b))) start_pt end_pt)
                             ) ;_ end of getpoint
                           ) ;_ end of lambda
                        ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'list
         ) ;_ end of =
      dir
      ) ;_ end of and
     (progn
       (setq tg  (/ (* 70. pi) (* 4. 180.))
             tg  (/ (sin tg) (cos tg))
             dir (< (angle start_pt end_pt) (angle start_pt dir))
             ) ;_ end of setq
          ;((10 28686.9 4256.28) (40 . 0.0) (41 . 0.0) (42 . -0.315299) (10 19912.2 4256.28) (40 . 0.0) (41 . 0.0) (42 . -0.315299) (210 0.0 0.0 1.0))
       (entmakex (list (cons 0 "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                       '(90 . 4)
                       '(70 . 0)
                       '(43 . 0.0)
                       '(38 . 0.0)
                       '(39 . 0.0)
                       (cons 10 start_pt)
                       '(40 . 0.)
                       '(41 . 0.)
                       (cons 42
                             (if dir
                               tg
                               (- tg)
                               ) ;_ end of if
                             ) ;_ end of cons
                       (cons 10
                             (setq mid (polar start_pt
                                              (angle start_pt end_pt)
                                              (/ (distance start_pt end_pt) 2.)
                                              ) ;_ end of polar
                                   ) ;_ end of setq
                             ) ;_ end of cons
                       '(40 . 0.)
                       '(41 . 0.)
                       (cons 42
                             (if dir
                               (- tg)
                               tg
                               ) ;_ end of if
                             ) ;_ end of cons
                       (cons 10 end_pt)
                       '(40 . 0.)
                       '(41 . 0.)
                       (cons 42
                             (if dir
                               (- tg)
                               tg
                               ) ;_ end of if
                             ) ;_ end of cons
                       (cons 10 mid)
                       '(40 . 0.)
                       '(41 . 0.)
                       (cons 42
                             (if dir
                               (- tg)
                               tg
                               ) ;_ end of if
                             ) ;_ end of cons
                       ) ;_ end of list
                 ) ;_ end of entmakex
       ) ;_ end of progn
     ) ;_ end of if
  (redraw)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Пример вызова:

Код:

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

Command: round-break

30.10.2007, 11:27

Кулик Алексей aka kpblc,

Да я просто копировал,а не записывал и строка начиналась- С: ....
У меня другое ща.Запустил код (см. прилож) и привязки пропали.Все они включены.Брал я его
http://dwg.ru/f/showthread.php?t=132...E1%F0%FB%E2%E0

Кулик Алексей aka kpblc · 30.10.2007, 11:32

Из кода №9 привязки не затрагиваются. Слетели, может, пораньше?
Кстати, мой вариант сработал?

30.10.2007, 11:43

Кулик Алексей aka kpblc,

Да.Вот сейчас только попробовал.Мне кстати показалось удобнее чем у VIС153.

vic153,

Без обид.

Огромное спасибо за помощь всем.

Apelsinov · 30.10.2007, 12:07

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

Кулик Алексей aka kpblc · 30.10.2007, 12:11

Туда же: поворот еще не забудь. Подобная тема была, если интересно, посмотри коды в http://dwg.ru/f/showthread.php?t=11905

Vova · 30.10.2007, 14:48

^C^C(SETQ OSM (GETVAR "OSMODE"));OSMODE;0;_pLine;_NEA;\(SETQ P1 (GETVAR "LASTPOINT"));_PER;\;'_CAL;P2=@;;P3=(P1+P2)/2;_SELECT;_L;;_PL;!P1;_W;0;;_A;_A;70;!P3;!P2;_A;-70;!P3;;_E;_P;;(SETVAR "OSMODE" OSM)

Денис Флюстиков · 31.10.2007, 08:24

Как вариант:
http://dwg.ru/dnl/311

extraneous · 28.11.2012, 18:13

Товарищи форумчане! Надеюсь, ничего страшного, что отвечаю в старой теме.
Мне вот тоже надо было соорудить макрос, рисующий символ обрыва трубы. Я тут понемногу разбираюсь с макросами и Лиспом, и наваял небольшой код. Предлагаю вам попробовать и покритиковать.
Началось всё с того, что я сделал условный символ разрыва трубы из книги "Язык макрокоманд и создание кнопок". Но код, хорошо работающий в 2002, выдает ошибку в 2009: "Требуется 2D точка или ключевое слово". Как выяснилось, функция ['саl;Р1=Cur;] в 2002 выводит координаты X и Y (вида 0,0), а в 2009 - X, Y и Z (вида 0,0,0). Дли полилинии же требуются только две координаты.
Решил проблему, включив в макрос лисп-выражение, выдергивающее нужные координаты из массива (nth).
Проблема макроса из книги - в том, что сложно угадать, в какую сторону повернется символ. Поэтому я добавил еще один щелчок, после установки символа, для его поворота по месту. Перед поворотом отключаются привязки и включается Орто; в конце команды переменные возвращаются к исходным. Принцип поворота: после вставки сдвигаем мышь вправо и видим символ таким, каким мы его нарисовали. Если нормально - щелкаем мышью, если нет - сдвигаем мышь влево, символ повернется на 180, щелчком подтверждаем выбор.
Иконка для кнопки - в архиве.

Код:

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

^C^C'_cal;P1=Cur;\;P2=Cur;_Per;\;'_cal;P3=(P1+P2)/2;_Pline;(list (nth 0 P1) (nth 1 P1));_W;0.6;;_Ar;_Ang;70;(list (nth 0 P3) (nth 1 P3));(list (nth 0 P2) (nth 1 P2));_W;0;;_Ang;-70;(list (nth 0 P3) (nth 1 P3));;(setq osn (getvar "osmode") orth (getvar "Orthomode"));orthomode;1;osmode;0;_rotate;_last;;(list (nth 0 p3) (nth 1 p3));\^C(setvar "osmode" osn)(setvar "orthomode" orth)

VVA · 30.11.2012, 19:08

Взято отсюда. Доделано, чтобы понимал локализаванные версии Автокада

Код:

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

(defun c:RCUT (/ pt1 pt2 ent mid oldlay rcut_error olcmdecho oldlay
olosmode)
;_http://www.herculedesign.com/Free%20AutoCAD.htm
(defun rcut_error (msg)
(if (or (= msg "Function cancelled") (/= msg "quit / exit abort"))
(princ (strcat "Error: " msg))
)
(command "_.undo" "_e" "_undo" "")
(setvar "CMDECHO" olcmdecho)
(setvar "OSMODE" olosmode)
(setvar "CLAYER" oldlay)
(setq *error* old_err
old_err nil
)
(princ)
)
(setq old_err *error*
*error* rcut_error
)
(setq olosmode (getvar "OSMODE")
olcmdecho (getvar "CMDECHO")
oldlay (getvar "clayer")
)
(setvar "cmdecho" 0)
(command "_.undo" "_be")
(prompt "\n RCUT - draws a cylindrical break mark")
(initget 1)
(setq pt1 (getpoint "\nPick right endpoint: "))
(initget 1)
(setq pt2 (getpoint pt1 "\nPick left endpoint: "))
(setq ent (ssget pt1))
(if ent (setvar "clayer" (cdr (assoc 8 (entget (ssname ent 0)))))
)
(setq mid (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2.0)))
(setvar "osmode" 0)
(command "_.arc" pt1 "_e" mid "_a" 90.0 "_.arc" "" pt2 "_.arc" mid "_e" pt2 "_a" 90.0)
(command "_.undo" "_e")
(setvar "CLAYER" oldlay)
(setvar "OSMODE" olosmode)
(setvar "CMDECHO" olcmdecho)
(setq *error* old_err)
(princ)
)
(princ)

30.10.2007, 09:22		#1
Макрос на "обрыв" трубы. Владимир Егорьев Сообщений: n/a Добрый день. Помогите отредактировать макрос который предлагает В.Свет или поделитесь своим вариантом. Вариант MechaniCS мне как-то не очень. Автокад 2006-русский. ^C^C'_Cal;P1=Cur;_Nea;\P2=Cur;_Per;\_Pline; '_Cal;P1;_W;0; ;_Ar;_Ang;70; '_Cal;P3=(P1+P2)/2; '_Cal;P2;_Ang;-70; '_Cal;P3; ;
Просмотров: 4285

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как прокладывать трубы канализации под полом?	slimmy	Водоснабжение и водоотведение	33	11.05.2016 10:38
Две дымовые трубы на одном фундаменте	EUDGEN	Основания и фундаменты	25	02.06.2010 18:08
допускаемая температура среды в которой укладываются трубы	rex_209	Прочее. Архитектура и строительство	4	25.09.2007 12:54
Нужен макрос (поворот на 90 предварительно выделенного)	dextron3	Программирование	20	10.07.2007 21:36
Кнопка макрос для включения слоя?	dextron3	Программирование	13	09.04.2007 12:44