[Tonic]

Добрый вечер!
Такое задание: создать программу для отрисовки выносной линии с цветом 132 и соем 6. Это я сделал. Теперь нужно с помощью кнопок на панели реализовать смещение (поворот) на +90, -90 и +180 градусов (как на рисунке), ещё создать кнопку, ответственную за изменение масштаба выноски (по умолчанию должно предлагаться <0.75>). Прикрепляю свои достижения на сегодняшний день и файл, где показано, что надо сделать. Буду благодарен за помощь и подсказки - я только недавно влился в ваши ряды =)
P.S. Язык нужен именно AutoLISP, не VisualLISP, т.к. программирование не для Автокада.

(defun c:vnsk (/ p1 p2 p3 p4 p5 p9 x1 x2 h th K tplus dtex TexP TexM ce bm osm ort col lay) ;; Сохранение значений и установка системных переменных и исходных данных (setq ce (getvar "CMDECHO") bm (getvar "BLIPMODE") osm (getvar "OSMODE") ort (getvar "ORTHOMODE") col (getvar "CECOLOR") lay (getvar "CLAYER") ) (setvar "ORTHOMODE" 0) (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "OSMODE" 16383) (setvar "CECOLOR" "132");Текущий цвет - 132 (setvar "CLAYER" "6");Текущий слой - 6 ;; ----------------------------------------------------------------------- (setq p1 (getpoint "\nУкажите начальную точку выносной линии: ")) (setq p2 (getpoint p1 "\nУкажите точку полочки: ")) (command "_LINE" p1 p2 "");Построение линии выноски (setvar "OSMODE" 0) (setq x1 (nth 0 p1));Присвоение переменной x1 координаты точки p1 (setq x2 (nth 0 p2));Присвоение переменной x2 координаты точки p2 (setq h (getreal "\nВведите высоту шрифта <3.5>: ")) (if (<= h 0) (setq h 3.5) ) ;end if (setq th (* h 1.6)) (setq tplus (* h 0.285)) (setq p4 (list (nth 0 p2) (nth 1 p2) (nth 2 p2))) (princ "Введите текст первой строки:") (setq TexP (getstring 4 5));Ввод текста верхней строки с клавиатуры (if (> x2 x1);Сравнение координат начала и конца линии выноски для определения её направления (progn;Для случая, когда полочка идёт вправо от линии выноски (setq p9 (list (+ (nth 0 p4) tplus) (+ (nth 1 p4) tplus) (nth 2 p4))) (command "_TEXT" p9 h 0 TexP "");Размещение верхнего текста (setq dtex (distance (nth 0 (textbox (entget (entlast)))) (nth 1 (textbox (entget (entlast)))))) (setq p5 (list (+ (nth 0 p4) dtex tplus) (nth 1 p4) (nth 2 p4))) (command "_LINE" p4 p5 "");Отрисовка полочки );end progn (progn;Для случая, когда полочка идёт влево от линии выноски (setq p9 (list (- (nth 0 p4) tplus) (+ (nth 1 p4) tplus) (nth 2 p4))) (command "_TEXT" "в" "Р" p9 h 0 TexP "");Размещение верхнего текста (setq dtex (distance (nth 0 (textbox (entget (entlast)))) (nth 1 (textbox (entget (entlast)))))) (setq p5 (list (- (nth 0 p4) dtex tplus) (nth 1 p4) (nth 2 p4))) (command "_LINE" p4 p5 "");Отрисовка полочки );end progn );end if (setq p4 (list (nth 0 p4) (- (nth 1 p4) th) (nth 2 p4)));Точка начала нижнего текста (princ "Введите текст второй строки:") (setq TexP (getstring 4 5));Ввод текста нижней строки с клавиатуры (if (> x2 x1);Сравнение координат начала и конца линии выноски для определения её направления (progn;Для случая, когда полочка идёт вправо от линии выноски (setq p9 (list (+ (nth 0 p4) tplus) (+ (nth 1 p4) tplus) (nth 2 p4))) (command "_TEXT" p9 h 0 TexP "");Размещение нижнего текста );end progn (progn;Для случая, когда полочка идёт влево от линии выноски (setq p9 (list (- (nth 0 p4) tplus) (+ (nth 1 p4) tplus) (nth 2 p4))) (command "_TEXT" "в" "Р" p9 h 0 TexP "");Размещение нижнего текста );end progn );end if ;; восстановление значений системных переменных (setvar "BLIPMODE" bm) (setvar "CMDECHO" ce) (setvar "OSMODE" osm) (setvar "ORTHOMODE" ort) (setvar "CECOLOR" col) (setvar "CLAYER" lay) (princ) (command "_REDRAW") (princ);Выход );end defun c

[ATTACH]1182873491.jpg[/ATTACH]

[Кулик Алексей aka kpblc]

Во-первых, СПДС - это arx-приложение, там все достаточно сильно друг на друга завязано, и выдрать оттуда кусок ИМХО нереально.
Во-вторых. В BricsCAD'e лично у меня не распозналась в свое время стандартная штукенция - function. Так что я бы не говорил даже о полной совместимости на этом уровне. Попробуй в бриксе запустить:

Код:

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

(defun test ()
  (mapcar
    (function
      (lambda (x)
	(entmakex (list (cons 0 "POINT") (cons 10 x)))
	) ;_ end of lambda
      ) ;_ end of function
    '((0. 0.) (10. 10.))
    ) ;_ end of mapcar
  ) ;_ end of defun

В-третьих. Построение примитивов, тем более временное, не есть гуд - особенно учитывая, что в Бриксе отсутствует штатный аналог _audit. Попробуй пройтись чистой геометрией и математикой. ИМХО это более правильно будет.

[ShaggyDoc]

Сообщение от Tonic Может, есть хотя бы алгоритмы попроще?

Да что уж алгоритм. Вот программа

Код:

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

(defun start (/               end_pnt_first_leader
              end_pnt_common_leader           ang_leaders
              align           length_txt      offset
              pnt_0           pnt_1           pnt_2
              s
             )
  (ru-app-begin)
  (setq offset (ru-conv-millimeter-in-paper-to-unit 2))
  (while
    (setq pnt_0 (ru-get-point-or-exit "Начало первой выноски" nil))
     (setq pnt_1 (ru-get-point-reguired "Конец первой выноски" pnt_0)
           end_pnt_first_leader
            pnt_1
           ang_leaders
            (angle pnt_0 pnt_1)
     ) ;_ end of setq
     (ru-line-add pnt_0 pnt_1 0 nil)
     (setq pnt_2 (ru-get-point-reguired "Конец общей полки" pnt_1))
     (grdraw pnt_2 pnt_1 (ru-conv-color-to-number (getvar "CECOLOR")))
     (setq
       end_pnt_common_leader
        pnt_2
       pnt_1 (ru-get-point-reguired "Начало текста обозначения" pnt_2)
     ) ;_ end of setq
     (grdraw pnt_1 pnt_2 (ru-conv-color-to-number (getvar "CECOLOR")))
     (setq S          (ru-get-string-reguired "Обозначение узла: " "1")
           pnt_0      pnt_2
           align      (ru-text-end-leader-align (angle pnt_2 pnt_1))
           length_txt (+ (ru-string-length s (ru-normal-text-height))
                         (ru-conv-millimeter-in-paper-to-unit 6)
                      ) ;_ end of +
     ) ;_ end of setq
     ;; длина строки 
     (if (= align acalignmentright)
       (setq pnt_2 (polar pnt_1 (ru-geom-go-back 0) length_txt)
             pnt_0 (polar (polar pnt_2
                                 (ru-geom-go-left 0)
                                 offset
                          ) ;_ end of polar
                          0
                          offset
                   ) ;_ end of polar
       ) ;_ end of setq
       (setq pnt_2 (polar pnt_1 0 length_txt)
             pnt_0 (polar (polar pnt_1
                                 (ru-geom-go-left 0)
                                 offset
                          ) ;_ end of polar
                          0
                          offset
                   ) ;_ end of polar
       ) ;_ end of setq
     ) ;_ end of if
     (ru-line-add-multi
       (list end_pnt_first_leader end_pnt_common_leader pnt_1 pnt_2)
       nil
       0
       nil
     ) ;_ end of ru-line-add-multi

     (ru-text-add S pnt_0 (ru-normal-text-height) 0 align)

     (if (setq pnt_0 (ru-get-point-or-exit "Начало ссылки на лист" nil))
       (ru-text-add
         (ru-get-string-reguired "Текст ссылки: " "Лист  ")
         pnt_0
         (ru-normal-text-height)
         0
         acalignmentleft
       ) ;_ end of ru-text-add
     ) ;_ end of if
     (while (setq pnt_0 (ru-get-point-or-exit "Следующее изделие" nil))
       (ru-line-add-multi
         (list (ru-conv-3dPoint-to-2dPoint pnt_0)
               (inters (ru-conv-3dPoint-to-2dPoint pnt_0)
                       (ru-conv-3dPoint-to-2dPoint (polar pnt_0 ang_leaders 100.0))
                       (ru-conv-3dPoint-to-2dPoint end_pnt_first_leader)
                       (ru-conv-3dPoint-to-2dPoint end_pnt_common_leader)
                       NIL
               ) ;_ end of inters
               (ru-conv-3dPoint-to-2dPoint end_pnt_common_leader)
         ) ;_ end of list
         nil
         0
         nil
       ) ;_ end of 
     ) ;_ end of while
  ) ;_ end of while
  (ru-app-end)
  (princ)
) ;_ end of defun

Вот из нее и извлекай алгоритм

[Tonic]

Кулик Алексей aka kpblc, хех... приложение делаю для BricsCAD, а запускаю в Автокад. Попробовал эту прогу оттуда - столкнулся с тем, что не знаю, как её запустить. Приложение-то загрузил, а вот как вызвать его? В Автокаде надо просто написать в командной строке имя после defun, а тут выдаёт ошибку.

Построение примитивов, тем более временное, не есть гуд - особенно учитывая, что в Бриксе отсутствует штатный аналог _audit.

А зачем _audit нужен? Можно же извлекать своевременно имена последних построенных примитивов, а потом их удалить, не пользуясь этой функцией.
ShaggyDoc, что это за язык? ru-app-begin, ru-conv-millimeter-in-paper-to-unit - первый раз вижу (и мой Автокад тоже) =)

[Кулик Алексей aka kpblc]

Запускай как (test) - в скобках.

А зачем _audit нужен? Можно же извлекать своевременно имена последних построенных примитивов, а потом их удалить, не пользуясь этой функцией.

Ох-ох-ох... Ладно, расскажу. Каждый примитив обладает неизменной меткой - хендлом (хранится в группе 5 и назначается самим autocad'ом или bricscad'ом). Эти хендлы, или заголовки, хранятся все время и их невозможно изменить. Если ты создал примитив и тут же его удалил, то хендл на следующий примитив будет все равно назначен уникальным, и не будет повторять хендл удаленного примитива. И вот еще - количество этих хендлов ограничено. Оно достаточно велико, но все же не бесконечно. Соответственно при очень интенсивной работе ты (теоретически) можешь выйти за пределы границ хендлов. После этого поведение пакета становится непредсказуемым - он может отказаться создавать примитивы или сохранять их. А может и вообще отказаться работать
_audit иногда подобную ситуацию лечит, но именно иногда. Соответственно приходится использовать _wblock, который в Brics'e (по крайней мере у меня так получилось) не всегда корректно срабатывает, особенно на расширенных данных, сохраненных на примитиве (у меня из 200 примитивов с пользовательскими РД 3 штуки их потеряли после _wblock, также был потерян пользовательский словарь файла; а подробно в причинах я копаться не стал).

[Krieger]

Сообщение от Tonic Работает, но это не совсем то, что требуется. Программа, строящая выноски, у меня есть (я приводил примерный текст), а надо, чтобы пользователь, нажавший на кнопку на панели "+180" и указавший на уже построенную ранее выноску, получил её переворот на этот угол, причём текст не должен перевернуться.

Я ему про Фому, он мне про Ерему.
Яж тебе и не давал готового решения... Ну вот сделаешь ты свою выноску из отрезков и текста и что ты с ним дальше будешь делать? Дальше это не выноска, а набор отрезков и текста. И чтоб тебе отредактировать свою выноску тебе надо будет всякие stretсh, move испоользовать, полка сама за текстом не побежит, а значит надо будет её отдельно удлинять.
Я тебе предложил leader с любыми стрелками и ассоциированный с ним блок, т.е. двигаешь блок - за ним сам бежит кончик leader-а. Можно без ассоциаций загнать это все в группу и будут всего две ручки для редактирования.
Дальше. Надо тебе дополнительную кнопку для поворота. Как ты собираешся свои разобщенные отрезки с текстом крутить вокруг неизвестной точки? А у блока все вместе и базовую точку искать не надо - это точка вставки. Как я уже сказал в случае с блоком и без кнопок здесь все решается просто, но можно и доп. кнопки сделать. Запросто взять entmod и поменять угол??? Да и выравнивание атрибутов туда же??? Хотя, наверное ты прикрепишь расширенные данные и запустишь реакторы - флаг в руки.

[Tonic]

Krieger, зачем так злиться? Я просто ещё не всё понимаю, и то, что кажется вам легким и простым, мне надо осмыслять и изучать.

[Кулик Алексей aka kpblc]

> Krieger : В бриксе нет реакторов. Только если писать на VC++ dll-ки, которые и подгружать. Но это, как заявлено было, требует нехилого знания С++, MFC и ObjectARX для AutoCAD'a

[Krieger]

>Tonic
Хоть ты и подтер постинг, я успел прочитать
Пересечение определять незачем, можно элементарно вычислить координату нужной точки, например так:

Код:

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

(polar pt3 (angle pt1 pt2) (distance pt1 pt2))

Смотри как работает:

Код:

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

(defun C:q ()
(setq pt1 (getpoint "\nУкажите начальную точку выносной линии: "))
  (if (setq pt2 (getpoint pt1 "\nУкажите точку полочки: "))
    (progn
      (entmake
		     (list '(0 . "LEADER") '(100 . "AcDbEntity") (cons 8  (getvar "clayer")) '(100 . "AcDbLeader") (cons 3 (getvar "DIMSTYLE"))
		       '(71 . 1) '(72 . 0) '(73 . 3) '(74 . 1) '(75 . 0) '(40 . 0.0) '(41 . 0.0) '(76 . 2)
		       (cons 10 pt1)
		       (cons 10 pt2)
		      );end list
		     )
      (while (setq pt3 (getpoint pt1 "\nНачало следующей выносной линии <хватит>: "))
	(entmake
		     (list '(0 . "LEADER") '(100 . "AcDbEntity") (cons 8  (getvar "clayer")) '(100 . "AcDbLeader") (cons 3 (getvar "DIMSTYLE"))
		       '(71 . 1) '(72 . 0) '(73 . 3) '(74 . 1) '(75 . 0) '(40 . 0.0) '(41 . 0.0) '(76 . 2)
		       (cons 10 pt3)
		       (cons 10 (setq pt4 (polar pt3 (angle pt1 pt2) (distance pt1 pt2))))
		      );end list
		     )
	);end while
      (entmake
		     (list
		       '(0 . "LINE") '(100 . "AcDbEntity") '(67 . 0) (cons 8 (getvar "clayer")) '(100 . "AcDbLine")
		       (cons 10 pt2)
		       (cons 11 pt4)
		      );end list
		     )
      );end progn
    );end if
   );end defun

[Krieger]

В BricsCAD'e есть функция error?

[Кулик Алексей aka kpblc]

Есть. Только не error, a *error*

[Tonic]

Krieger, у меня эта программа вот что чертит:
[ATTACH]1183127681.jpg[/ATTACH]

[Tonic]

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

(defun C:greb (/ p1 p2 p3 peres xli1 xli2 ang anggr pxl1 pxl2 TexP h dist cenp pt1) (setvar "ORTHOMODE" 0) (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "OSMODE" 16383) (setvar "CECOLOR" "132");Текущий цвет - 132 (setvar "CLAYER" "6");Текущий слой - 6 (setq p1 (getpoint "\nУкажите начальную точку выносной линии: ")) (setq p2 (getpoint p1 "\nУкажите точку полочки: ")) (command "_LINE" p1 p2 ""); Построение первой линии выноски (command "_XLINE" "_hor" p2 ""); Построение временной прямой вместо полочки (setq xli1 (cdr (assoc -1 (entget (entlast))))); Сохранение имени последнего примитива (прямой) (setq ang (angle p1 p2)); Сохранение угла между выноской и осью ОХ (setq anggr (* 180 (/ ang pi))); Преобразование угла из радиан в градусы (setq pxl1 (polar p2 0 1)); Вычисление второй точки на горизонтальной прямой (setq p3 (getpoint "\nНачало следующей выносной линии: ")) (while (/= p3 nil); Пока пользователь не нажмёт Enter (command "_XLINE" "_ang" anggr p3 ""); Построение временной прямой для след. выноски (setq xli2 (cdr (assoc -1 (entget (entlast))))); Сохранение имени последнего примитива (прямой) (setq pxl2 (polar p3 ang 1)); Вычисление второй точки на прямой (setq peres (inters p2 pxl1 p3 pxl2 nil)); Определение координат точки перечечения прямых (command "_LINE" p3 peres ""); Отрисовка следующей линии-выноски (entdel xli2); Удаление временной прямой (setq p3 (getpoint "\nНачало следующей выносной линии: ")) );end while (command "_LINE" p2 peres ""); Отрисовка полочки (entdel xli1); Удаление временной горизонтальной прямой (princ "\n Введите текст верхней строки: ") (setq TexP (getstring 4 5)) (setq h 3); Высота текста (setq dist (distance p2 peres)); Длина полочки (setq cenp (polar p2 0 (/ dist 2))); Координаты центра полочки (setq pt1 (list (nth 0 cenp) (+ (/ h 2) (nth 1 cenp)) (nth 2 cenp))); Координаты центра верхнего текста (command "_TEXT" "_c" pt1 h 0 TexP ""); Верхний текст по центру (princ "\n Введите текст нижней строки: ") (setq TexP (getstring 4 5)) (setq pt1 (list (nth 0 cenp) (- (nth 1 cenp) (* h 1.5)) (nth 2 cenp))); Координаты центра верхнего текста (command "_TEXT" "_c" pt1 h 0 TexP ""); Нижний текст по центру (princ) (command "_REDRAW") (princ);Выход ); end greb

Ну и, если придумаю как, сделаю временные прямые невидимыми, но это уже мелочи.

[Krieger]

>Tonic
По твоему коду:
Если нет слоя "6" - выдаст ошибку, значит надо проверить его наличие и если его нет создать. Например так:

Код:

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

(if (not (tblobjname "layer" "6"))
  (command "_-layer" "_New" "6" ""))

Если выбрать опцию "_make", то слой установится текущим.

При использовании функции command следует отключать привязки (setvar "OSMODE" 0), а после выполнения их возвращать. Вообще все настройки надо бы вернуть т.е. и текущий цвет, и слой.

setq можно каждый раз не писать и такой текст:

Код:

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

(setq TexP (getstring 4 5)) 
(setq h 3); Высота текста 
(setq dist (distance p2 peres)); Длина полочки 
(setq cenp (polar p2 0 (/ dist 2))); Координаты центра полочки 
(setq pt1 (list (nth 0 cenp) (+ (/ h 2) (nth 1 cenp)) (nth 2 cenp)))

Можно записать так:

Код:

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

(setq TexP (getstring 4 5) 
	h 3
	dist (distance p2 peres)
	cenp (polar p2 0 (/ dist 2))
	pt1 (list (nth 0 cenp) (+ (/ h 2) (nth 1 cenp)) (nth 2 cenp)))

Перед указанием второй точки можно поставить условие, если указал - работаем дальше, пустой ввод ничего не далается, т.е. работа команды корректно прекращается. Тоже самое при вводе текста.

Строчку

Код:

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

(setq p3 (getpoint "\nНачало следующей выносной линии: "))

Можно поставить сразу в условие функции while. Т.е. не указал точку - while завершает цикл.

Код:

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

(setq xli1 (cdr (assoc -1 (entget (entlast)))))

Масло масленное, т.к. entlast и так возвращает имя примитива, достаточно так:

Код:

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

(setq xli1 (entlast))

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

При нажатий кнопки "esc" все полетит в тар-тарары (тем более если еще привязки отключить), для этого случая можно создать функцию *error*, которая и восстановит все значения.

[Krieger]

Ну и для затравки мой код, с использованием entmake:

Код:

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

(defun C:greben (/ pt1 pt2 pt3 pt4 pt5 dist pt_first pt_second p ss *error* TexP)
 (defun *error* (msg)
    (foreach p ss (entdel p))
  (princ "Функция отменена")
)
(setq pt1 (getpoint "\nУкажите начальную точку выносной линии: ")) 
  (if (setq pt2 (getpoint pt1 "\nУкажите точку полочки: ")) 
    (progn 
      (entmake
	   (list '(0 . "LINE") '(100 . "AcDbEntity")
	     '(8 . "6");слой
	     '(62 . 132);цвет
	     '(100 . "AcDbLine") 
             (cons 10 (trans pt1 1 0)) 
             (cons 11 (trans pt2 1 0)) 
            );end list
           );end entmake
      (setq pt_first pt2
	    pt_second pt2
	    ss (list (entlast)))
      (while (setq pt3 (getpoint "\nНачало следующей выносной линии <хватит>: "))
	(setq dist (/ (- (cadr pt2) (cadr pt3)) (sin (angle pt1 pt2)))
	      pt5 (setq pt4 (polar pt3 (angle pt1 pt2) dist))
	      )
   (entmake
	   (list
             '(0 . "LINE") '(100 . "AcDbEntity") '(8 . "6") '(62 . 132) '(100 . "AcDbLine")
             (cons 10 (trans pt3 1 0))
             (cons 11 (trans pt5 1 0))
            );end list
           );end entmake
	(cond ((and 	(> (car pt5)  (car pt_first))
		 	(> (car pt5) (car pt_second))) (setq pt_second pt5))
	      ((and 	(< (car pt5)  (car pt_first))
		 	(< (car pt5) (car pt_second))) (setq pt_first pt5))
	      );end cond
	(grdraw pt_first pt_second 132 0)
	(setq ss (append ss (list (entlast))))
   );end while
      (entmake
           (list 
             '(0 . "LINE") '(100 . "AcDbEntity") '(8 . "6") '(62 . 132) '(100 . "AcDbLine")
             (cons 10 (trans pt_first 1 0))
             (cons 11 (trans pt_second 1 0))
            );end list
           );end entmake
      (setq ss (append ss (list (entlast))))
      (if (not  (eq "" (setq TexP (getstring T "\nВведите текст верхней строки <не надо> : "))))
	(entmake
	  (list '(0 . "TEXT") '(100 . "AcDbEntity")
		'(8 . "6");слой
		'(62 . 132);цвет
		'(100 . "AcDbText") '(10 0.0 0.0 0.0)
		'(40 . 3);высота текста
		(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)));угол наклона
		(cons 1 TexP);собсно текст
		(cons 7 (getvar "textstyle"))
		'(71 . 0) '(72 . 1)
		(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2))
			(+ (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0))
	'(73 . 0))
	  );entmake
	);if
      (setq ss (append ss (list (entlast))))
      (if (not  (eq "" (setq TexP (getstring T "\nВведите текст верхней строки <не надо> : "))))
	(entmake
	  (list '(0 . "TEXT") '(100 . "AcDbEntity")
		'(8 . "6");слой
		'(62 . 132);цвет
		'(100 . "AcDbText") '(10 0.0 0.0 0.0) '(40 . 3)
		(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)))
		(cons 1 TexP)
		(cons 7 (getvar "textstyle"))
		'(71 . 0) '(72 . 1)
		(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2))
				(- (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0))
		'(73 . 3))
	  );entmake
	);if
      (princ)
      );end progn
    (progn (princ "Функция отменена") (princ))
    );end if 
   )

[Tonic]

Спасибо! Буду учиться грамотности на автолиспе!
Отлично, в этом коде нет проблем, таких как нелепая временная прямая. Класс!
Только я не весь код понимаю. Не могли бы вы дать комментарии? Особенно сложные конструкции с and, if, да и всё остальное =)

[Krieger]

Лови:

Код:

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

(defun C:greben (/ pt1 pt2 pt3 pt4 pt5 dist pt_first pt_second p ss *error* TexP)
 (defun *error* (msg);эта функция срабатывает при возникновении ошибки
    (foreach p ss (entdel p));если случилась ошибка - удаляем то что уже успели нарисовать
  (princ "Функция отменена");выводимое сообщение при возникн. ошибки
);end defun
(setq pt1 (getpoint "\nУкажите начальную точку выносной линии: "));указываем первую точку 
  (if (setq pt2 (getpoint pt1 "\nУкажите точку полочки: "));если указали вторую точку - работаем дальше, иначе сообщение в конце кода
    (progn ;программная скобка
      (entmake	;создаем отрезок
	   (list '(0 . "LINE") '(100 . "AcDbEntity")
	     '(8 . "6");слой
	     '(62 . 132);цвет
	     '(100 . "AcDbLine") 
             (cons 10 (trans pt1 1 0));координата начала отрезка
             (cons 11 (trans pt2 1 0));координата конца отрезка
            );end list
           );end entmake
      (setq pt_first pt2;запоминаем крайнию левую точку как pt2, т.к. пока она у нас одна
	    pt_second pt2;запоминаем крайнию правую точку как pt2, т.к. пока она у нас одна
	    ss (list (entlast)));запоминаем ename последнего созданного примитива (отрезок)
      (while (setq pt3 (getpoint "\nНачало следующей выносной линии <хватит>: "));циклим указание точек и отрисовку отрезков
	;цикл продолжается до тех пор пока getpoint не выдаст nil, т.е. не будет указана точка (пустой ввод)
	(setq dist (/ (- (cadr pt2) (cadr pt3)) (sin (angle pt1 pt2)));вычисляем длину будующего отрезка
	      pt5 (setq pt4 (polar pt3 (angle pt1 pt2) dist));вычисляем координату точки примыкания отрезка с полкой
	      );элементарная геометрия - прикинь на листике - все будет понятно
   (entmake;создаем отрезок по указанной и вычисленной точкам
	   (list
             '(0 . "LINE");тип примитива
	     '(100 . "AcDbEntity");маркер подкласса
	     '(8 . "6");слой
	     '(62 . 132);цвет
	     '(100 . "AcDbLine");маркер подкласса
             (cons 10 (trans pt3 1 0));координата начала отрезка
             (cons 11 (trans pt5 1 0));координата конца отрезка
	     ;функция trans используется для перевода координат из текущей ucs в мировую
            );end list
           );end entmake
	(cond ((and 	(> (car pt5)  (car pt_first));сравниваем X вычисленной точки с крайней левой точкой
		 	(> (car pt5) (car pt_second));сравниваем X вычисленной точки с крайней правой точкой
			);and выдаст t, если выполнены оба условия, иначе nil
	       (setq pt_second pt5));если t, то крайней правой точкой назначаем pt5
	      ((and 	(< (car pt5)  (car pt_first));сравниваем X вычисленной точки с крайней левой точкой
		 	(< (car pt5) (car pt_second));сравниваем X вычисленной точки с крайней правой точкой
			);and выдаст t, если выполнены оба условия, иначе nil
	       (setq pt_first pt5));если t, то крайней левой точкой назначаем pt5
	      );end cond
	(grdraw pt_first pt_second 132 0);отрисовываем временный отрезок от точки pt_first до pt_second, цветом 132 без подсветки
	;этот отрезок не является примитивом и исчезнет при первой же перерисовке рисунка
	(setq ss (append ss (list (entlast))));добавляем ename последнего отрезка в список ss,
	;таким образом мы запомним все вычерченные отрезки, чтобы удалить их при возникновении ошибки
   );end while
      (entmake;вместо grdraw теперь уже создадим примитив от pt_first до pt_second
           (list 
             '(0 . "LINE") '(100 . "AcDbEntity") '(8 . "6") '(62 . 132) '(100 . "AcDbLine")
             (cons 10 (trans pt_first 1 0));координата начала отрезка
             (cons 11 (trans pt_second 1 0));координата конца отрезка
            );end list
           );end entmake
      (setq ss (append ss (list (entlast))));и тоже его запомним в списке ss
      (if (not
	    (eq ""
		(setq TexP (getstring T "\nВведите текст верхней строки <не надо> : "));вводим текст (разрешаем пробелы)
	    );сравниваем со строкой нулевой длины
	   );обратное значение T или nil
	;если ввод не нулевой - создадим TEXT
	(entmake
	  (list '(0 . "TEXT");тип примитива
		'(100 . "AcDbEntity");маркер подкласса
		'(8 . "6");слой
		'(62 . 132);цвет
		'(100 . "AcDbText");маркер подкласса
		'(10 0.0 0.0 0.0);первая точка привязки (нулевая т.к. использую выравнивание)
		'(40 . 3);высота текста
		(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)));угол наклона
		(cons 1 TexP);собсно текст
		(cons 7 (getvar "textstyle"));текстовый стиль (взят текущий)
		'(71 . 0);слева на право и не вверх ногами
		'(72 . 1);выравнивание - центр
		(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2))
			(+ (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0));точка вставки (вторая точка привязки)
		;хоть полка и горизонтальная, всеравно вычисляю угол наклона, т.к. возможна работа с повернутой ucs.
		'(73 . 0);выравнивание - по базовой линии
		);end list
	  );entmake
	);if
      (setq ss (append ss (list (entlast))));сохраняем Text в "расстрельный" список
      ;дальше тоже самое но с нижним тектом:
      (if (not (eq "" (setq TexP (getstring T "\nВведите текст нижней строки <не надо> : "))))
	(entmake
	  (list '(0 . "TEXT") '(100 . "AcDbEntity")
		'(8 . "6");слой
		'(62 . 132);цвет
		'(100 . "AcDbText") '(10 0.0 0.0 0.0) '(40 . 3)
		(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)))
		(cons 1 TexP)
		(cons 7 (getvar "textstyle"))
		'(71 . 0);слева на право и не вверх ногами
		'(72 . 1);выравнивание - центр
		(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2))
				(- (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0))
		'(73 . 3);выравнивание - по верхней границе
		);end list
	);if
      ;в список ss не сохраняем т.к. ошибаться уже вроде негде
      (princ);мягкий выход (чтоб не было эха от работы entmake)
      );end progn
    (progn (princ "Функция отменена") (princ));сообщение выводится если не указана точка для полки tp2
    );end if 
   );end defun

[Tonic]

Krieger, разобрался в коде, за исключением строк:

dist (/ (- (cadr pt2) (cadr pt3)) (sin (angle pt1 pt2)));вычисляем длину будующего отрезка - каким образом? я что-то смутно представляю, что получится, если координату новой точки разделить на синус угла
pt5 (setq pt4 (polar pt3 (angle pt1 pt2) dist)) - pt4 так и не пригодилась, поэтому я её викинул (наверно, ваша описка)
(cons 10 (trans pt3 1 0)) - зачем переводить в другую систему координат?
;этот отрезок не является примитивом и исчезнет при первой же перерисовке рисунка - когда программа завершена, и я удаляю полученную выноску, линия остаётся на экране, пока не двинешь линию прокрутки. Поставил в конце (command "_REDRAW") - помогло
(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)));угол наклона - зависит от точек? почему?
(cons 1 TexP);собсно текст
(cons 7... - нет разницы, что список будет склеен не по порядку?
'(71 . 0) - не вверх ногами - это, наверно, и так по умолчанию?
(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2))
(+ (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0));точка вставки (вторая точка привязки) - самая непонятная строка!
'(73 . 0) - выравнивание по базовой линии - это как?


И ещё: сколько времени было потрачено на написание этого кода? На мой взгляд, очень профессионально, всё продумано до мелочей!

[Krieger]

dist (/ (- (cadr pt2) (cadr pt3)) (sin (angle pt1 pt2)));вычисляем длину будующего отрезка - каким образом? я что-то смутно представляю, что получится, если координату новой точки разделить на синус угла

А ты на листике прикинул, как я рекомендовал?

элементарная геометрия - прикинь на листике - все будет понятно

Делим не координаты точки, а разность координат Y точек при указке полки и указанной pt3. Т.е. катет делим на синус угла и получаем гипотенузу.

pt5 (setq pt4 (polar pt3 (angle pt1 pt2) dist)) - pt4 так и не пригодилась, поэтому я её викинул (наверно, ваша описка)

Да, описка.

(cons 10 (trans pt3 1 0)) - зачем переводить в другую систему координат?

Не в другую, а в мировую. Положение UCS может поменять пользователь, например, многие поворачивают ucs для простановки размеров под углом. Если не делать этот перевод, то при измененной пользователем ucs, он будет указывать точки в одном месте, а появляться отрезки будут в другом. Entmake не отслеживает положение UCS, а getpoint возвращает точки в текущей системе.

этот отрезок не является примитивом и исчезнет при первой же перерисовке рисунка - когда программа завершена, и я удаляю полученную выноску, линия остаётся на экране, пока не двинешь линию прокрутки. Поставил в конце (command "_REDRAW") - помогло

А зачем ты её удалил? Тебе мешает линия отрисованная grdraw? Мне нет. Я, впринципе и использовал grdraw, потому что с ней возится не надо, отрисовал и забыл, сама исчезнет при любом пане или зуме. Ну, можешь и перерисовать..., только еще тогда её в *error* добавь.

(cons 50 (angle (trans pt_first 1 0) (trans pt_second 1 0)));угол наклона - зависит от точек? почему?

А от чего он потвоему должен зависеть? Угол я определяю опять таки для защиты от поворота пользователем ucs.

(cons 7... - нет разницы, что список будет склеен не по порядку?

Ты про список, который в entmake передается? Это ассоциированный список, поэтому особой разницы нет. Порядок важен когда идут группы с одинаковым кодом, например точки полилинии все имеют код 10.

'(71 . 0) - не вверх ногами - это, наверно, и так по умолчанию?

Ну вообще много чего по умолчанию, вроде и без него работает, помоему и маркеры подкласса можно убрать. Я делаю так: рисую примитив, потом (entget (car (entsel))), полученный список копирую и правлю убирая лишнее, и иногда лучше донеубрать чем ломать голову, почему не работает.

(cons 11 (trans (polar (polar pt_first (angle pt_first pt_second) (/ (distance pt_first pt_second) 2)) (+ (angle pt_first pt_second) (* 0.5 pi)) 1.5) 1 0));точка вставки (вторая точка привязки) - самая непонятная строка!

Здесь вычисляется середина полки, учитывая то что она может быть под углом и отступается 1.5мм вверх от полки под углом на 90град больше чем угол полки.

'(73 . 0) - выравнивание по базовой линии - это как?

Это один из типов вертикального выравнивания 0 - по базовой линии, 1 - по нижней границе, 2 - по середине, 3 - по верхней границе.

И ещё: сколько времени было потрачено на написание этого кода?

Этот ответ я писал, наверно минут 15. Про код - не засекал, наверно что-то около часа.

На мой взгляд, очень профессионально, всё продумано до мелочей!

Спасибо, но до профи мне далеко, я только учусь

[Кулик Алексей aka kpblc]

> Krieger : Ты что, решил ликбезом по DXF заняться?
> Tonic : учитывая, что в BricsCAD'e достаточно жиденькая справка (по моим общим ощущениям), а также то, что ты работаешь в AutoCAD'e, отлаживая проги, тебе мой совет - находясь в VLIDE, нажми F1 и перейди на DXF Reference - там написано все, что тебе Krieger рассказал и еще немеряно другого

[Tonic]

Сообщение от Krieger А ты на листике прикинул, как я рекомендовал? Делим не координаты точки, а разность координат Y точек при указке полки и указанной pt3. Т.е. катет делим на синус угла и получаем гипотенузу.

Понятно, надо учебник по геометрии снова открывать =)

Кулик Алексей aka kpblc, и в Help'е, и в книге Полещука (AutoLISP&VisualLISP) про DXF написано суховато. Вот стандартный список для LINE:

100 Subclass marker (AcDbLine) 39 Thickness (optional; default = 0) 10 Start point (in WCS) DXF: X value; APP: 3D point 20, 30 DXF: Y and Z values of start point (in WCS) 11 Endpoint (in WCS) DXF: X value; APP: 3D point 21, 31 DXF: Y and Z values of endpoint (in WCS) 210 Extrusion direction (optional; default = 0, 0, 1) DXF: X value; APP: 3D vector 220, 230 DXF: Y and Z values of extrusion direction (optional)

Да и не совсем понятно: когда "работает" APP, а когда DXF.