мой первый лисп, выноска, пинайте!

baaba · 16.09.2009, 23:44

Вот, хочу поделиться радостью: написал первую программу на автолиспе. Понимаю что велосипед (построение выноски), но то что я нашёл (может плохо искал) мне не совсем подходило. Может быть кому-нибудь пригодится. Да, расчитано на шрифт gosta_w.shx или что то подобное.

Код:

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

;; Построение простой выноски.
(defun  C:le2() (setq ang 0) (drawlead)) ;Вызов из коммандной строки "le2", или ... 
(defun  C:le2r() (setq ang pi) (drawlead)) ;реверсивное начертание, "le2r"
(defun  drawlead()
(setq   pt1 (getpoint "\nEnter first point, target: "); Точка указания выноски
        pt2 (getpoint pt1 "\nEnter second point, text baseline: ") ;Точка построения текста выноски
        t1  (getstring t "\nText:") ;Содержание строки
        bl  (* 2 (+ 1 (strlen t1))) ;Определение длины подчёркивания (для gosta_w.shx)
        th  3 ;Высота шрифта - три единицы
        sf  (getvar "DIMSCALE") ;Перед началом работы выставить DIMSCALE
        h   (* sf th)) ;Высота шрифта, с переменной DIMSCALE
(if (< (car pt1) (car pt2)) (setq ang2 ang) (setq ang2 (+ ang pi))); определение направления построения выноски
(command "LINE" pt1 pt2 (polar pt2 ang2 (* sf bl)) "") ;построение линий 
(command "TEXT" "J" "BC" (polar pt2 ang2 (* sf bl 0.5)) h 0 t1)) ;написание текста

Кулик Алексей aka kpblc · 16.09.2009, 23:53

Первое. В официальной локализации работать не будет.
Второе. Создание текста ориентировано на строго определенные настройки активного текстового стиля.
Третье. Нет меток начала и конца отмены
Четвертое. Нет обработчика ошибок.
---
Это что сразу бросилось в глаза.

baaba · 17.09.2009, 00:14

Цитата:

Третье. Нет меток начала и конца отмены

Не понятно, что это?

engngr · 17.09.2009, 00:18

Выполните лисп. Начните выполнять отмену: лисп будет отменяться команда за командой - без меток. С метками - будут отменяться группы или весь набор команд лиспа сразу.

baaba · 17.09.2009, 00:24

Цитата:

Выполните лисп. Начните выполнять отмену: лисп будет отменяться команда за командой - без меток. С метками - будут отменяться группы или весь набор команд лиспа сразу.

Спасибо! Теперь понятно. Можно увидеть пример листинга?

Кулик Алексей aka kpblc · 17.09.2009, 00:47

Изменения выделил красным

Код:

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

;; Построение простой выноски.
(defun c:le2 ()
          ;Вызов из коммандной строки "le2", или ... 
  (setq ang 0)
  (drawlead)
  ) ;_ end of defun

(defun c:le2r () ;реверсивное начертание, "le2r"
  (setq ang pi)
  (drawlead)
  ) ;_ end of defun

(defun drawlead ()
  (command "_.undo" "_begin")
  (setq pt1 (getpoint "\nEnter first point, target: ")
          ; Точка указания выноски
        pt2 (getpoint pt1 "\nEnter second point, text baseline: ")
          ;Точка построения текста выноски
        t1  (getstring t "\nText:") ;Содержание строки
        bl  (* 2 (+ 1 (strlen t1)))
          ;Определение длины подчёркивания (для gosta_w.shx)
        th  3 ;Высота шрифта - три единицы
        sf  (getvar "DIMSCALE")
          ;Перед началом работы выставить DIMSCALE
        h   (* sf th)
        ) ;Высота шрифта, с переменной DIMSCALE
  (if (< (car pt1) (car pt2))
    (setq ang2 ang)
    (setq ang2 (+ ang pi))
    )     ; определение направления построения выноски
  (command "_.LINE" pt1 pt2 (polar pt2 ang2 (* sf bl)) "")
          ;построение линий 
  (command "_.TEXT"
           "_J"
           "_BC"
           (polar pt2 ang2 (* sf bl 0.5))
           h
           0
           t1
           ) ;_ end of command
  (command "_.undo" "_end")
  (princ)
  )       ;написание текста

Profan · 17.09.2009, 06:15

Все переменные - глобальные.
А запросы в командной строке на английском - на кого расчитаны?

VVA · 17.09.2009, 13:39

Вставлю я свои 5 копеек
1. Не обрабатываются грабли №1 (OSNAP)
Читай здесь с поста #167, а еще лучше проработать всю тему
2. (Коментарии)

Цитата:

Первое. В официальной локализации работать не будет.

Читай ПРАВИЛО
3.

Цитата:

Второе. Создание текста ориентировано на строго определенные настройки активного текстового стиля.

Создай текстовый стиль с высотой, отличной от 0. Установи его текущим и попробуй выполнить свою команду

baaba · Регистрация: 07.07.2007

Жаль, так поздно отвечаю. Вот, кажется всё поправил. Как теперь, нормально?

Код:

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

;; Построение простой выноски. Вызов: le2. le2r - реверсивное начертание.
;; Высота текста задаётся переменной DIMSCALE. Полочка выноски
;; соответствует длине строки, если шрифт gosta_w.shx, или подобный.
;; Опубликовано: http://forum.dwg.ru/showthread.php?t=40090
(defun  C:le2() (setq ang 0) (drawlead)) 
(defun  C:le2r(ang / pt1 pt2 t1 bl th sf h) (setq ang pi) (drawlead))
(defun  drawlead()
(command "_.undo" "_begin")
(setq old_osnap (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq   pt1 (getpoint "\nEnter first point, target: ")
        pt2 (getpoint pt1 "\nEnter second point, text baseline: ")
        t1  (getstring t "\nText:")
        bl  (* 2 (+ 1 (strlen t1)))
        th  3 
        sf  (getvar "DIMSCALE")
        h   (* sf th))
(if (< (car pt1) (car pt2)) (setq ang2 ang) (setq ang2 (+ ang pi)))
(command "_.LINE" pt1 pt2 (polar pt2 ang2 (* sf bl)) "")
;; Ввод текста. САПР на базе Автокад, стр. 248, листинг 10.32., если установлена 
;; ненулевая высота текста диалог ввода текста различается.
(if (= (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
    (command "_.TEXT" "_J" "_BC" (polar pt2 ang2 (* sf bl 0.5)) h 0 t1)
    (command "_.TEXT" "_J" "_BC" (polar pt2 ang2 (* sf bl 0.5)) 0 t1))
(setvar "OSMODE" old_osnap)
(command "_.undo" "_end")
(princ))

Krieger · 13.10.2009, 06:06

А так не лучше?

Код:

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

^C^C_Leader;\\;;;

Почему отказываешься от лидера?

Profan · 13.10.2009, 06:23

Цитата:

;; Высота текста задаётся переменной DIMSCALE.

Неправильно.

baaba · 14.10.2009, 00:05

Цитата:

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

Почему отказываешься от лидера?

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

Цитата:

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

;; Высота текста задаётся переменной DIMSCALE.
Неправильно.

Обоснуй пожалуйста.

Profan · 14.10.2009, 05:35

А тут и обосновывать нечего. Высота текста размерного стиля в единицах рисунка задается переменной DIMTXT при условии, что в текстовом стиле не задана фиксированная высота. А DIMSCALE - общий масштабный КОЭФФИЦИЕНТ для размерных составляющих.

kheylan · 14.10.2009, 08:43

baaba,
Мне понравилась твоя выноска, у нас тоже до AutoCAD 2008 все (блоки, штриховки...) было привязано к этой переменной DIMSCALE, на подобии СПДС
НО с 2008 пошла аннотация и DIMSCALE = 0, чтобы работали аннотативные размеры и появились мультивыноски, сейчас удобно использовать их с настроенными стилями

baaba · 15.10.2009, 00:07

Цитата:

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

baaba,
Мне понравилась твоя выноска, у нас тоже до AutoCAD 2008 все (блоки, штриховки...) было привязано к этой переменной DIMSCALE, на подобии СПДС

Спасибо! Очень приятно такое слышать, не ожидал! )))))

Цитата:

НО с 2008 пошла аннотация и DIMSCALE = 0, чтобы работали аннотативные размеры и появились мультивыноски, сейчас удобно использовать их с настроенными стилями

Пожалуйста, строка 16,
sf (getvar "DIMSCALE") заменить на
sf (getvar "DIMTXT")

baaba · Регистрация: 07.07.2007

Вот, исправил отключение привязки. Было немного неверно: привязку надо отключать непосредственно перед функцией рисования. В момент ввода, пользователь может много раз менять значение привязки.
Второе - я недостаточно понимал суть использования аргументов функции. Также продекларировал локальные переменные. Подумаю что можно будет сделать с DIMSCALE. Просто почувствовал ответственность за написанное, правда

люди ведь могут пользоваться а могут плюнуть и выбросить.

Код:

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

;; Построение простой выноски. Вызов: le2. le2r - реверсивное начертание.
;; Высота текста задаётся переменной DIMSCALE. Полочка выноски
;; соответствует длине строки, если шрифт gosta_w.shx, или подобный.
;; Опубликовано: http://forum.dwg.ru/showthread.php?t=40090

(defun C:le2() (drawlead 0))
(defun C:le2r() (drawlead pi))
(defun drawlead (ang / pt1 pt2 t1 bl th sf h an2 old_osnap)
(command "_.undo" "_begin");Метка отмены группы комманд
(setq	pt1 (getpoint "\nEnter first point, target: ")
		pt2	(getpoint pt1 "\nEnter second point, text baseline: ")
		t1	(getstring t "\nText:")
		bl	(* 2 (+ 1 (strlen t1)))
		th  3 
		sf	(getvar "DIMSCALE")
		h	(* sf th))
(setq old_osnap (getvar "OSMODE"));При рисовании привязка должна быть отключена
(setvar "OSMODE" 0)
(if (< (car pt1) (car pt2)) (setq an2 ang) (setq an2 (+ ang pi)))
(command "_.LINE" pt1 pt2 (polar pt2 an2 (* sf bl)) "")
;; Ввод текста. САПР на базе Автокад, стр. 248, листинг 10.32., если установлена 
;; ненулевая высота текста диалог ввода текста различается.
(if (= (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
	(command "_.TEXT" "_J" "_BC" (polar pt2 an2 (* sf bl 0.5)) h 0 t1)
	(command "_.TEXT" "_J" "_BC" (polar pt2 an2 (* sf bl 0.5)) 0 t1))
(setvar "OSMODE" old_osnap);Восстановление привязки
(command "_.undo" "_end");Метка отмены группы комманд
(princ))

Кулик Алексей aka kpblc · 19.10.2009, 14:13

Вариант, без изменения Osmode:

Код:

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

(defun draw-lead (/ adoc *error* loc pt1 pt2 pt3 ang text style)

  (defun *error* (msg)
    (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
  (setq loc (wcmatch (strcase (ver)) "*RU*"))
  (if (and (= (type (setq pt1 (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint
                                      (strcat
                                        "\n"
                                        (if loc
                                          "Укажите первую точку, базу"
                                          "Enter first point, target"
                                          ) ;_ end of if
                                        " <"
                                        (if loc
                                          "Отмена"
                                          "Cancel"
                                          ) ;_ end of if
                                        "> : "
                                        ) ;_ end of strcat
                                      ) ;_ end of getpoint
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           pt1
           (= (type (setq pt2 (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (getpoint
                                      pt1
                                      (strcat
                                        "\n"
                                        (if loc
                                          "Укажите точку положения текста"
                                          "Enter text placement point"
                                          ) ;_ end of if
                                        " <"
                                        (if loc
                                          "Отмена"
                                          "Cancel"
                                          ) ;_ end of if
                                        "> : "
                                        ) ;_ end of strcat
                                      ) ;_ end of getpoint
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'list
              ) ;_ end of =
           pt2
           (= (type (setq txt
                           (vl-catch-all-apply
                             (function
                               (lambda ()
                                 (getstring t
                                            (strcat "\n"
                                                    (if loc
                                                      "Текст"
                                                      "Text"
                                                      ) ;_ end of if
                                                    " <"
                                                    (if loc
                                                      "Отмена"
                                                      "Cancel"
                                                      ) ;_ end of if
                                                    "> : "
                                                    ) ;_ end of strcat
                                            ) ;_ end of getstring
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'str
              ) ;_ end of =
           (/= txt "")
           ) ;_ end of and
    (progn
      (entmakex (list (cons 0 "LINE")
                      (cons 10 pt1)
                      (cons 11 pt2)
                      ) ;_ end of list
                ) ;_ end of entmakex
      (entmakex
        (list
          (cons 0 "LINE")
          (cons 10 pt2)
          (cons
            11
            (setq pt3 (polar
                        pt2
                        (+ pi
                           (setq ang (if (< (car pt1) (car pt2))
                                       0
                                       pi
                                       ) ;_ end of if
                                 ) ;_ end of setq
                           ) ;_ end of +
                        ((lambda (/ box)
                           (- (caar (setq
                                      box
                                       (textbox
                                         (list
                                           (cons 0 "TEXT")
                                           (cons 10 '(0. 0. 0.))
                                           (cons 210 '(0. 0. 1.))
                                           (cons 40 (* 3. (getvar "dimscale")))
                                           (cons 1 txt)
                                           ) ;_ end of list
                                         ) ;_ end of textbox
                                      ) ;_ end of setq
                                    ) ;_ end of caar
                              (caadr box)
                              ) ;_ end of -
                           ) ;_ end of lambda
                         )
                        ) ;_ end of polar
                  ) ;_ end of setq
            ) ;_ end of cons
          ) ;_ end of list
        ) ;_ end of entmakex
      (entmakex
        (list
          (cons 0 "TEXT")
          '(100 . "AcDbEntity")
          '(100 . "AcDbText")
          (cons 10
                (setq
                  pt3 (list (if (equal ang 0. 1e-3)
                              (+ (car pt2) (getvar "dimscale"))
                              (- (car pt2) (getvar "dimscale"))
                              ) ;_ end of if
                            (+ (cadr pt3)
                               (* (getvar "dimscale") (getvar "dimgap"))
                               ) ;_ end of +
                            ) ;_ end of list
                  ) ;_ end of setq
                ) ;_ end of cons
          (cons 11 pt3)
          (cons 1 txt)
          (cons 72
                (if (equal ang 0. 1e-3)
                  0
                  2
                  ) ;_ end of if
                ) ;_ end of cons
          (cons 7 (getvar "textstyle"))
          (cons 40 (* (getvar "textsize") (getvar "dimscale")))
          (assoc 41
                 (entget (tblobjname "style" (getvar "textstyle")))
                 ) ;_ end of assoc
          (assoc 50
                 (entget (tblobjname "style" (getvar "textstyle")))
                 ) ;_ end of assoc
          (cons 73 0)
          '(100 . "AcDbText")
          ) ;_ end of list
        ) ;_ end of entmakex

      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

baaba · Регистрация: 07.07.2007

Вот, набросал вариант для выставления координат, при составлении разбивочного плана, в разделе Генеральный план. Мне кажется, в ряде случаев, это может быть полезным. Принцип действия таков:
1. Установить ucs в начало координат разбивочной сетки;
2. В коде lisp (понимаю что это недоработка) учтановить шаг сетки (у меня сейчас стоит 50 метров)
3. Загрузить программу, например так: (load "c:\путь_к_программе\lead5.lsp")
4. Использовать le2 или le2r, для реверсивного начертания.

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

Угловатости буду дорабатывать, на досуге.

Код:

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

;;=============================lead5.lsp======================================
;;Рисование выносок, с указанием координат, относительно разбивочной сетки,
;;при выполнении разбивочного плана (раздел Генеральный план)
(defun C:le2() 
	(command "_.undo" "_begin")
	(drawlead 0)
	(command "_.undo" "_end"))
(defun C:le2r()
	(command "_.undo" "_begin")
	(drawlead pi)
	(command "_.undo" "_end"))

;Функция рисования выноски
(defun drawlead (ang / pt1 pt2 gs up_txt dn_txt bl th sf h old_snap an2)
(setq	pt1 (getpoint "\nEnter first point, target: ")
		pt2	(getpoint pt1 "\nEnter second point, text baseline: ")
		gs 50 ;шаг сетки
		up_txt (gstr pt1 gs 'y)
		dn_txt (gstr pt1 gs 'x)
		bl (* 2 (+ 1 (strlen up_txt)))
		th 3 
		sf (getvar "DIMSCALE")
		h (* sf th)
		old_osnap (getvar "OSMODE"))
(if (< (car pt1) (car pt2)) (setq an2 ang) (setq an2 (+ ang pi)))
(setvar "OSMODE" 0)
(command "_.LINE" pt1 pt2 (polar pt2 an2 (* sf bl)) "")
(drawtxt "_BC" (polar pt2 an2 (* sf bl 0.5)) h up_txt)
(drawtxt "_TC"	(polar (polar pt2 an2 (* sf bl 0.5))
				(* pi -0.5) (* sf 1)) h dn_txt)
(setvar "OSMODE" old_osnap))

;Функция написания текста
(defun drawtxt (t_just t_place t_height t_str)
	(if (= (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
		(command "_.TEXT" "_J" t_just t_place t_height 0 t_str)
		(command "_.TEXT" "_J" t_just t_place 0 t_str)))

;Функция вычисления координат вида: "4A+13.68"
(defun gstr (pt1 gs xw / getel tpart bstep btail stxt)
	(if (= xw 'x) (setq getel 'car tpart "Б+") (setq getel 'cadr tpart "А+"))
  	(setq bstep (fix (/ ((eval getel) pt1) gs)))
	(setq btail (- ((eval getel) pt1) (* bstep gs)))	
	(setq stxt (strcat (itoa bstep) tpart (rtos btail 2 2)))
	(princ stxt))