Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Работа лиспа в AutoCAD 2007 и AutoCAD 2008

Работа лиспа в AutoCAD 2007 и AutoCAD 2008

Ответ
Поиск в этой теме
Непрочитано 07.10.2016, 16:03 #1
Работа лиспа в AutoCAD 2007 и AutoCAD 2008
olga87
 
Регистрация: 28.05.2007
Сообщений: 207

Здравствуйте Уважаемые программисты!
Подскажите пожалуйста, как исправить код лиспа ниже, чтобы он одинаково работал в AutoCAD 2007 и AutoCAD 2008?
Сейчас работает так: НА РИСУНКЕ НИЖЕ: "красным" - работа в AutoCAD 2007, "черным" - работа в AutoCAD 2008 (разное смещение слева и относительно полки).
Код взят с форума.
Спасибо!

Нажмите на изображение для увеличения
Название: 7и8.png
Просмотров: 34
Размер:	9.7 Кб
ID:	177387

Код:
[Выделить все]
(defun C:strxy()
	(command "_.undo" "_begin")
	(drawlead 0)
	(command "_.undo" "_end"))
;Функция рисования выноски
(defun drawlead (ang / szht pt1 pt2 gs up_txt dn_txt bl h an2)
	(vl-load-com)
	(princ "\nLUPREC value = ")(princ (getvar "LUPREC"))
	(princ "  TEXTSIZE value = ")(princ (getvar "TEXTSIZE"))

	(setq szht (getreal (strcat "\nВведите высоту текста <" (rtos (getvar "TEXTSIZE")) ">: ")))
	(if (null szht)
		(setq szht (getvar "TEXTSIZE"))
		(setvar "TEXTSIZE" szht))

	(setq pt1 (getpoint "\nУкажите точку для считывания координат: ")
		pt2	(getpoint pt1 "\nУкажите размещение полки с текстом: ")
		gs 100 ;шаг сетки
		up_txt (gstr pt1 gs 'y)
		dn_txt (gstr pt1 gs 'x)
		bl (* szht (- (strlen up_txt) 1.5))
		h szht
	)
	(if (< (car pt1) (car pt2)) (setq an2 ang) (setq an2 (+ ang pi)))
	(command "_.LINE" pt1 pt2 (polar pt2 an2 (* bl)) "")
	(drawtxt "_BL" (polar pt2 an2 (* bl 0.06)) h up_txt)
	(drawtxt "_TL" (polar (polar pt2 an2 (* bl 0.06))
		(* pi -0.5) (* h 0.27)) h dn_txt)
)
;Функция написания текста
(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))
)
;Функция вычисления координат вида: "0A+50"
(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 (vl-string-translate "." "," (rtos btail 2))))
	(princ stxt)
)

Просмотров: 2782
 
Непрочитано 07.10.2016, 16:59
#2
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 163


Привязки отключите.
frostmourn вне форума  
 
Автор темы   Непрочитано 07.10.2016, 22:18
#3
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Спасибо, работает!

----- добавлено через ~12 мин. -----
Разрешите еще Вас спросить:
Код выше работает с выбором высоты текста пользователем только в случае, если в текущем текстовом стиле нулевая высота. Подскажите пожалуйста, как внести изменения в код, чтобы бралась только высота введенная пользователем в первом запросе вне зависимости от высоты в текущем текстовом стиле?
Спасибо!

Последний раз редактировалось olga87, 07.10.2016 в 22:32.
olga87 вне форума  
 
Непрочитано 08.10.2016, 14:45
#4
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 163


Так. И ещё теперь должно со включенными привязками работать, вроде.
Код:
[Выделить все]
 
(defun C:strxy()
	(command "_.undo" "_begin")
	(drawlead 0)
	(command "_.undo" "_end"))
;Функция рисования выноски
(defun drawlead (ang / szht pt1 pt2 gs up_txt dn_txt bl h an2)
	(vl-load-com)
	(princ "\nLUPREC value = ")(princ (getvar "LUPREC"))
	(princ "  TEXTSIZE value = ")(princ (getvar "TEXTSIZE"))

	(setq szht (getreal (strcat "\nВведите высоту текста <" (rtos (getvar "TEXTSIZE")) ">: ")))
	(if (null szht)
		(setq szht (getvar "TEXTSIZE"))
		(setvar "TEXTSIZE" szht))
		
	(setq pt1 (getpoint "\nУкажите точку для считывания координат: ")
		pt2	(getpoint pt1 "\nУкажите размещение полки с текстом: ")
		gs 100 ;шаг сетки
		up_txt (gstr pt1 gs 'y)
		dn_txt (gstr pt1 gs 'x)
		bl (* szht (- (strlen up_txt) 1.5))
		h szht
	)
	(if (< (car pt1) (car pt2)) (setq an2 ang) (setq an2 (+ ang pi)))
	(command "_.LINE" "_non" pt1 pt2 "_non" (polar pt2 an2 (* bl)) "")
	(drawtxt "_BL" (polar pt2 an2 (* bl 0.06)) h up_txt)
	(vla-put-Height (vlax-ename->vla-object(entlast)) szht)
	(drawtxt "_TL" (polar (polar pt2 an2 (* bl 0.06))
		(* pi -0.5) (* h 0.27)) h dn_txt)
		(vla-put-Height (vlax-ename->vla-object(entlast)) szht)
)
;Функция написания текста
(defun drawtxt (t_just t_place t_height t_str)
	(if (= (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 0.0)
		(command "_.TEXT" "_J" t_just "_non" t_place t_height 0 t_str)
		(command "_.TEXT" "_J" t_just "_non" t_place 0 t_str)
	)
)
;Функция вычисления координат вида: "0A+50"
(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 (vl-string-translate "." "," (rtos btail 2))))
	(princ stxt)
)
Только, по-хорошему, надо это с нуля переписывать и по-другому...
frostmourn вне форума  
 
Непрочитано 08.10.2016, 17:56
#5
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Конструкция (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) не обязательно вернет высоту, указанную в описании стиля. assoc, по-твоему, для чего придумали?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 08.10.2016, 22:23
#6
olga87


 
Регистрация: 28.05.2007
Сообщений: 207


Спасибо большое за Ваши подсказки!
olga87 вне форума  
 
Непрочитано 10.10.2016, 17:06
#7
frostmourn


 
Регистрация: 23.04.2015
Сообщений: 163


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Конструкция (cdr (cadddr (tblsearch "STYLE" (getvar "TEXTSTYLE")))) не обязательно вернет высоту, указанную в описании стиля. assoc, по-твоему, для чего придумали?
Оно и понятно, и это только один из возникающих вопросов. Но трогать не стал, ибо
Цитата:
Сообщение от frostmourn
надо это с нуля переписывать и по-другому...
frostmourn вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Работа лиспа в AutoCAD 2007 и AutoCAD 2008

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
ATABLE для autocad 2008 casaatik AutoCAD 181 07.03.2014 15:41
Панель "МОНОМАХ" в AutoCAD 2008 Bublik 22 Мономах 24 18.05.2013 23:50
Командв Isolate Objects и AutoCAD 2007; есть ли возможность добавить данную команду в AutoCAD 2007 Данила123456 AutoCAD 13 01.11.2011 13:44
Работа AUTOCAD 2008 и AUTOCAD 2010 c дальномером Leica DISTO D8 через BT AutoKirill AutoCAD 2 29.03.2011 14:36
Информация по идентификационным кодам программ в сетевых лицензиях Autodesk KSI AutoCAD 1 14.09.2009 15:59