dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Окно просмотра для пространства модели с масштабированием изображения

LISP. Окно просмотра для пространства модели с масштабированием изображения

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 14.11.2011, 16:24 #1
LISP. Окно просмотра для пространства модели с масштабированием изображения
Денис Флюстиков
 
СПб
Регистрация: 20.07.2005
Сообщений: 87

Денис Флюстиков вне форума Вставить имя

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

Код:
[Выделить все]
 
;|====================================================

Окно просмотра для пространства модели с масштабированием изображения

Программа Дениса Флюстикова "Zoom_Den"

Макрос для кнопки: ^C^C^P(load "Zoom_Den");Zoom_Den

Замечания и предложения по адресу fd-@mail.ru
====================================================|;

(defun c:Zoom_Den (/ aa0 aa1 aa2 aa3 aa4 aa5 aa6 aa7 aa8 aa9)

(if (= (getvar "TILEMODE") 1)(progn
(setq aa7 4					; Масштаб по умолчанию
      aa1 (strcat "\nПервый угол окна просмотра или <Изменить масштаб " (rtos aa7 2 4) ">:")
      aa1 (getpoint aa1))

(if (null aa1)(progn
(setq aa1 (strcat "\nНовый масштаб <" (rtos aa7 2 4) ">:")
      aa2 (getreal aa1))
(if aa2 (setq aa7 aa2))
(setq aa1 (getpoint "\nПервый угол окна просмотра:"))
))
      
(setq aa2 (getcorner aa1 "\nВторой угол окна просмотра:")
      aa1 (trans aa1 1 0)
      aa2 (trans aa2 1 0)
      aa3 (vl-sort (list (car aa1)(car aa2)) '<)
      aa4 (vl-sort (list (cadr aa1)(cadr aa2)) '<)
      aa2 (append aa3 aa4)
      aa0 (ssget "_A")
      aa1 "temp"
      aa5 '())

(while (tblsearch "block" aa1)
(setq aa1 (strcat aa1 "1")))

(setvar "CMDECHO" 0)
(command "_.undo" "_m")
(setvar "OSMODE" 0)
(command "_.block" aa1 '(0 0) aa0 ""
	 "_.oops"
	 "_.insert" aa1 "_s" aa7 '(0 0))
(while (= (getvar 'cmdactive) 1)(command ""))

(setq aa5 (entlast)
      aa0 (entget aa5)
      aa4 (list '(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		'(100 . "AcDbPolyline")
		'(90 . 4)
		'(70 . 1)
		'(43 . 0)
		(cons 10 (list (car aa2)(caddr aa2)))
		(cons 10 (list (cadr aa2)(caddr aa2)))
		(cons 10 (list (cadr aa2)(cadddr aa2)))
		(cons 10 (list (car aa2)(cadddr aa2)))))

(entmake aa4)
(vl-load-com)

(command "_.xclip" aa5 "" "_n" "_s" (setq aa6 (entlast))
	 "_.wipeout" "_p" aa6 "_n"
	 "_.draworder" aa5 aa6 "" "_f")

(setq aa5 (vlax-ename->vla-object aa5)
      aa6 (+ (cadr aa2)(car aa2))
      aa8 (+ (cadddr aa2)(caddr aa2))
      aa4 (list (/ aa6 2.)(/ aa8 2.))
      aa6 (/ (- (cadr aa2)(car aa2)) aa7)
      aa8 (/ (- (cadddr aa2)(caddr aa2)) aa7)
      aa9 (list (/ aa6 -2.)(/ aa8 -2.))
      aa8 (list '(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		'(100 . "AcDbPolyline")
		'(90 . 4)
		'(70 . 1)
		'(43 . 0)
		(cons 10 '(0 0))
		(cons 10 (list 0 aa8))
		(cons 10 (list aa6 aa8))
		(cons 10 (list aa6 0))))

(entmake aa8)

(setq aa8 (entget (entlast))
      aa6 (vla-getExtensiondictionary aa5)
      aa6 (vla-item (vla-item aa6 "ACAD_FILTER") "SPATIAL")
      aa6 (entget (vlax-vla-object->ename aa6)))

(princ "\nВыход: ESC, пробел или правый клик")
(while aa1
(setq aa1 (vl-catch-all-apply 'grread '(1 13 1)))
  
(if (= (type aa1) 'LIST)
(cond
((or (= (car aa1) 25)					; Правый клик
     (and (= (car aa1) 2)(= (cadr aa1) 32)))		; Пробел
(setq aa1 nil)
)
((= (car aa1) 5)					; Координаты
(setq aa1 (cadr aa1)
      aa3 (- 1 (vla-get-XEffectiveScaleFactor aa5))
      aa3 (mapcar '* (list aa3 aa3 aa3) aa1)
      aa0 (mapcar '- aa3 (mapcar '- aa1 aa4))
      aa2 (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint aa5)))
      aa2 (mapcar '- aa2 aa0)
      aa3 '())

(if (distance aa2 '(0 0 0))(progn

(mapcar '(lambda (x)
(if (= (car x) 10)
(setq aa3 (append aa3 (list (cons 10 (mapcar '+ (cdr x) aa2)))))
(setq aa3 (append aa3 (list x)))
)
) aa6)
(setq aa6 (entmod aa3)
      aa3 '()
      aa1 (trans aa1 1 0))

(vla-put-insertionpoint aa5 (vlax-3d-point aa0))

(mapcar '(lambda (x)
(if (= (car x) 10)
(setq aa3 (append aa3 (list (cons 10 (mapcar '+ (cdr x) aa1 aa9)))))
(setq aa3 (append aa3 (list x)))
)
) aa8)

(entmod aa3)

))
)
)
(setq aa1 nil)
))

(setq aa1 (angle (getvar "vsmax") (getvar "vsmin"))
      aa2 (/ (getvar "viewsize") (sin aa1))
      aa4 (getvar "viewctr")
      aa3 (polar aa4 aa1 (/ aa2 2.0))
      aa1 (polar aa3 aa1 (- aa2))
      )
  
(command "_.undo" "_b")
(setvar "CMDECHO" 1)
(if (> (distance aa4 (getvar "viewctr")) 0)
(command "'_.zoom" "_w" aa1 aa3)
)
)
(princ "\nДля модели")
)
(princ)
)
(princ)



Просмотров: 2058
 
Непрочитано 14.11.2011, 16:30
#2
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


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

А может не стоит тогда подобное в "готовые программы" закидывать?
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Окно просмотра для пространства модели с масштабированием изображения

РЕВЕРС. Автоматическая пакетная печать множества рамок (форматов) из пространства модели и листов
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программное позиционирование пространства модели во ViewPort Danger_pgs Программирование 8 10.06.2008 20:42
размер изображения в пространстве модели, как быстрее опреде Ptica_Oz Программирование 6 06.06.2007 11:13
Границы пространства модели bdfy AutoCAD 16 23.04.2006 16:13
Автоматическая печать из пространства модели Дмитрий_В AutoCAD 9 19.04.2006 16:52
Как в Автокаде в VBA указать окно просмотра (Window) Саша AutoCAD 1 06.09.2004 21:40

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||