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

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

Печать из модели по выбору объекта

Ответ
Поиск в этой теме
Непрочитано 21.10.2009, 12:41
Печать из модели по выбору объекта
zenon
 
Остекляем!!! Алюминим!!!
 
Москва
Регистрация: 21.02.2005
Сообщений: 3,825

Просьба не отсылать в поиск, ибо прошерстил, но не то.
Что хотелось бы, выбираешь объект, а программа сама определяет габариты границы объекта и отправляет на печать все что попадает в габариты.
Настройку предлагаю производить либо при первичной загрузке программы, либо предварительно настроить стиль печати.

ps см. в приложении что и как.

исходник.dwg

__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 73544
 
Непрочитано 22.10.2009, 22:03
#41
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Нижнюю левую точку находит верно, с правой верхней неполадки... Покопаюсь.
Do$ вне форума  
 
Непрочитано 22.10.2009, 22:04
#42
Кулик Алексей aka kpblc
Moderator

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


Ну, у меня фантазий сдох окончательно и бесповоротно
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 22.10.2009, 22:07
#43
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Код:
[Выделить все]
(defun test (/ ent lst min_point max_point)
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (car (entsel "\nБлок <Отмена> : "))
                                    ) ;_ end of lambda
                                  ) ;_ end of function
                                ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (setq ent (vlax-ename->vla-object ent))
           (vlax-property-available-p ent 'isdynamicblock)
           (equal (vla-get-isdynamicblock ent) :vlax-true)
           ) ;_ end of and
    (progn
      (vlax-for item (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name ent))
        (if (equal (vla-get-visible item) :vlax-true)
          (setq lst (cons item lst))
          ) ;_ end of if
        ) ;_ end of vlax-for
      (setq lst       (vl-remove nil
                                 (mapcar
                                   (function
                                     (lambda (x / minp maxp)
                                       (if (not (vl-catch-all-error-p
                                                  (vl-catch-all-apply
                                                    (function
                                                      (lambda ()
                                                        (vla-getboundingbox x 'minp 'maxp)
                                                        ) ;_ end of lambda
                                                      ) ;_ end of function
                                                    ) ;_ end of vl-catch-all-apply
                                                  ) ;_ end of vl-catch-all-error-p
                                                ) ;_ end of not
                                         (list (cons "min" (vlax-safearray->list minp))
                                               (cons "max" (vlax-safearray->list maxp))
                                               ) ;_ end of list
                                         ) ;_ end of if
                                       ) ;_ end of lambda
                                     ) ;_ end of function
                                   lst
                                   ) ;_ end of mapcar
                                 ) ;_ end of vl-remove
            min_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function min)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "min" x)))
                                                        ) ;_ end of function
                                                      lst
                                                      ) ;_ end of mapcar
                                                    ) ;_ end of mapcar
                                            ) ;_ end of apply
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      (list 'car 'cadr 'caddr)
                                      ) ;_ end of mapcar
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            max_point (mapcar (function +)
                              (mapcar (function
                                        (lambda (f)
                                          (apply
                                            (function max)
                                            (mapcar f
                                                    (mapcar
                                                      (function
                                                        (lambda (x) (cdr (assoc "max" x)))
                                                        ) ;_ end of function
                                                      lst
                                                      ) ;_ end of mapcar
                                                    ) ;_ end of mapcar
                                            ) ;_ end of apply
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      (list 'car 'cadr 'caddr)
                                      ) ;_ end of mapcar
                              (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint ent)))
                              ) ;_ end of mapcar
            lst       (list (cons "min" min_point) (cons "max" max_point))
            ) ;_ end of setq
      ) ;_ end of progn
    ) ;_ end of if
  lst
  ) ;_ end of defun
min вместо max было
ПС: Работает изумительно!
Do$ вне форума  
 
Непрочитано 22.10.2009, 22:13
#44
Кулик Алексей aka kpblc
Moderator

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


Offtop: Е-мое... Ну надо же было так лажануться! Что значит копи-паст кода.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 23.10.2009, 09:46
#45
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


Просьба к зубрам а теперь можно оформить сие в рабочую программу, с учетом поста 1
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 23.10.2009, 12:57
#46
Сергей Богатов


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


Offtop:
может понаделать листов и печатать из них?
__________________
Я-проектировщик бывший проектировщик!
Сергей Богатов вне форума  
 
Автор темы   Непрочитано 23.10.2009, 13:27
#47
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


Цитата:
Сообщение от Сергей Богатов Посмотреть сообщение
может понаделать листов и печатать из них?
Это не всегда оправдано, тут еще больше телодвижений чем при печати из модели
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 24.10.2009, 09:19
#48
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Здесь и здесь рассматривался метод бисекции. Так вот, этот метод вполне иожно применить для нахождения габаритного контейнера для сплайна (и не только) . Вот один из вариантов рекурсивного аналога getbounbox'a:
Код:
[Выделить все]
(defun rec-boundingBox (/ f test test1 lst obj)
  (setq f
      (lambda (x y)
        (apply
          'or
          (mapcar
            'minusp
            (mapcar '*
                    (vlax-curve-getFirstDeriv obj x)
                    (vlax-curve-getFirstDeriv obj y)
            ) ;_  mapcar
          ) ;_  mapcar
        ) ;_  apply
      ) ;_  lambda
  ) ;_  setq
  (defun test (a b d)
    (if (= a b)
      nil
      ((lambda (r)
         (if (equal a r d)
           r
           (if (f a r)
             (test a r d)
             (test r b d)
           ) ;_  if
         ) ;_  if
       ) ;_  lambda
        (/ (+ a b) 2.)
      )
    ) ;_  if
  ) ;_  defun
  (defun test1 (a b e)
    (cond
      ((> b e) (list e))
      ((f a b)
       (cons (test a b 1.0e-010) (test1 b (1+ b) e))
      )
      (t (test1 b (1+ b) e))
    ) ;_  cond
  ) ;_  defun
  (if
    (and (setq obj
                (car (entsel
                       "\nВыберите pline,spline,ellipse: "
                     ) ;_  entsel
                ) ;_  car
         ) ;_  setq
         (wcmatch (cdr (assoc 0 (entget obj)))
                  "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
         ) ;_  wcmatch
         (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of and
     ((lambda (lst)
        (list (list (apply 'min (mapcar 'car lst))
                    (apply 'min (mapcar 'cadr lst))
              ) ;_  list
              (list (apply 'max (mapcar 'car lst))
                    (apply 'max (mapcar 'cadr lst))
              ) ;_  list
        ) ;_  list
      ) ;_  lambda
       (mapcar
         '(lambda (x)
            (vlax-curve-getPointAtParam obj x)
          ) ;_  lambda
         (cons 0.0
               (test1 0 1 (vlax-curve-getEndParam obj))
         ) ;_  cons
       ) ;_  mapcar
     )
  ) ;_  if
) ;_  defun
 
;;;Проверка
(progn
  (vl-cmdf "_rectang")
  (apply 'vl-cmdf (rec-boundingBox))
) ;_ end of progn
CB вне форума  
 
Непрочитано 24.10.2009, 14:47
#49
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Код:
[Выделить все]
Команда: 'VLIDE _rectang
Первый угол или [Фаска/Уровень/Сопряжение/Высота/Ширина]:
Выберите pline,spline,ellipse: Возникла серьезная ошибка ***
достигнут внутренний предел стека (смоделирован)"\n*** INTERNAL ERROR: VL 
namespace mismatch\n"" type Y to reset: "y
Не справилась
Вложения
Тип файла: dwg
DWG 2004
spline_test_CB.dwg (33.2 Кб, 1569 просмотров)
Do$ вне форума  
 
Непрочитано 25.10.2009, 11:03
#50
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Согласен, при достаточно большом количестве иттераций рекурсивной функции (в данном примере ф-ция test1 имеет 30738 иттераций) и возникает эта ошибка...
Какой предел иттераций, от чего он зависит лично я не знаю, хотя на простом примере наверно это можно вычислить:
Код:
[Выделить все]
(defun rec-test (a)
  (setq b a)
  (rec-test (1+ a))
; вызов (rec-test 0)
Смотрим значение переменной b. У меня оно получилось - 19975.
Ну и теперь новый вариант ф-ции rec-boundingBox - рекурсия заменена циклом, ну и небольшие изменения, направленные на увеличение скорости
Код:
[Выделить все]
(defun rec-boundingBox (/ f test test1 lst obj)
 (setq
  f (lambda (x y)
     (equal
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj x)
      ) ;_  mapcar
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj y)
      ) ;_  mapcar
     ) ;_  equal
    ) ;_  lambda
 ) ;_  setq
 (defun test (a b d)
  (if (= a b)
   nil
   ((lambda (r)
     (if (equal a r d)
      r
      (if (f a r)
       (test r b d)
       (test a r d)
      ) ;_  if
     ) ;_  if
    ) ;_  lambda
    (/ (+ a b) 2.)
   )
  ) ;_  if
 ) ;_  defun
 (defun test1 (a b e / temp lst)
  (setq
   temp (mapcar 'minusp
                (vlax-curve-getFirstDeriv obj a)
        ) ;_  mapcar
  ) ;_  setq
  (while
   (cond
    ((> b e) (setq lst (cons e lst)) nil)
    ((equal
      temp
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj b)
      ) ;_  mapcar
     ) ;_  equal
     (setq b (1+ b))
    )
    (t
     (setq lst  (cons (test (1- b) b 1.0e-010) lst)
           a    b
           temp (mapcar 'minusp
                        (vlax-curve-getFirstDeriv obj a)
                ) ;_  mapcar
           b    (1+ b)
     ) ;_  setq
    )
   ) ;_  cond
  ) ;_  while
  lst
 ) ;_  defun
 (if
  (and (setq obj
             (car (entsel
                   "\nВыберите pline,spline,ellipse: "
                  ) ;_  entsel
             ) ;_  car
       ) ;_  setq
       (wcmatch (cdr (assoc 0 (entget obj)))
                "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
       ) ;_  wcmatch
       (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of and
  ((lambda (lst)
    (list (list (apply 'min (mapcar 'car lst))
                (apply 'min (mapcar 'cadr lst))
          ) ;_  list
          (list (apply 'max (mapcar 'car lst))
                (apply 'max (mapcar 'cadr lst))
          ) ;_  list
    ) ;_  list
   ) ;_  lambda
   (mapcar
    '(lambda (x)
      (vlax-curve-getPointAtParam obj x)
     ) ;_  lambda
    (cons 0.0
          (test1 0 1 (vlax-curve-getEndParam obj))
    ) ;_  cons
   ) ;_  mapcar
  )
 ) ;_  if
) ;_  defun
CB вне форума  
 
Непрочитано 26.10.2009, 10:18
#51
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от CB Посмотреть сообщение
иттераций
С одной "т" пишется
Цитата:
Сообщение от CB Посмотреть сообщение
Ну и теперь новый вариант ф-ции rec-boundingBox - рекурсия заменена циклом, ну и небольшие изменения, направленные на увеличение скорости
Сейчас значительно лучше! Даже с 3D сплайном справилась!
А вот со сплайном, полученным из сглаженной полилинии не подружилась.
И все же, метод бисекции довольно небыстр в плане сходимости. Поэтому предлагаю вариант, основанный на методе Ньютона:
Код:
[Выделить все]
(defun c:test (/ box)
  (vl-load-com)
  (setq	box
	 (Spline_getBoundingBox
	   (vlax-ename->vla-object (car (entsel "\nSelect spline:")))
	 ) ;_ end of Spline_getBoundingBox
  ) ;_ end of setq
  (setq	box
	 (list (list (cdr (assoc "Xmin" box)) (cdr (assoc "Ymin" box)))
	       (list (cdr (assoc "Xmax" box)) (cdr (assoc "Ymax" box)))
	 ) ;_ end of list
  ) ;_ end of setq
  (entmakex
    (list
      (cons 0 "LWPOLYLINE")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbPolyline")
      (cons 90 4)
      (cons 70 1)
      (cons 10 (car box))
      (cons 10
	    (list (caar box) (cadr (last box)) (last (car box)))
      ) ;_ end of cons
      (cons 10 (last box))
      (cons 10
	    (list (car (last box)) (cadar box) (last (car box)))
      ) ;_ end of cons
    ) ;_ end of list
  ) ;_ end of entmakex
) ;_ end of defun





(defun Spline_getBoundingBox (obj		  /
			      fpt_list		  pt_nul_lst
			      p_list
			      _kpblc-conv-list-to-3dpoints
			     )

;;;(Spline_getBoundingBox (vlax-ename->vla-object (car (entsel "\nSpline?:"))))
;;;(("Xmin" . 353.332) ("Xmax" . 14863.7) ("Ymin" . -10403.0) ("Ymax" . -2568.36))

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
				      ;|
*    Функция конвертации списка чисел в список 3-мерных точек. На основе уроков
* по рекурсиям Евгения Елпанова
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
      )
      (t
       (setq res (cons (list (car lst)
			     (if (cadr lst)
			       (cadr lst)
			       0.
			     ) ;_ end of if
			     (if (caddr lst)
			       (caddr lst)
			       0.
			     ) ;_ end of if
		       ) ;_ end of list
		       (_kpblc-conv-list-to-3dpoints (cdddr lst))
		 ) ;_ end of cons
       ) ;_ end of setq
      )
    ) ;_ end of cond
    res
  ) ;_ end of defun

  (if (and
	(= (type obj) (quote VLA-OBJECT))
	(= (vla-get-objectname obj) "AcDbSpline")
      ) ;_ end of and
    (apply (function append)
	   (mapcar
	     (function
	       (lambda (cadrs coord)
		 (setq pt_nul_lst
			(append
			  (mapcar
			    (function
			      (lambda (y)
				(cadrs (vlax-curve-getpointatparam obj y))
			      ) ;_ end of lambda
			    ) ;_ end of function
			    (vl-remove-if
			      (function
				(lambda	(z)
				  (or (> z (apply (function max) p_list))
				      (< z (apply (function min) p_list))
				  ) ;_ end of or
				) ;_ end of lambda
			      ) ;_ end of function
			      (mapcar
				(function
				  (lambda (p / f df it)
				    (setq it 0)
				    (while (not	(or (equal f 0.0 1.0e-010)
						    (equal df 0.0 1.0e-010)
						    (> it 500)
						) ;_ end of or
					   ) ;_ end of not
				      (setq
					it (1+ it)
					f  (cadrs
					     (vlax-curve-getfirstderiv
					       obj
					       p
					     ) ;_ end of vlax-curve-getfirstderiv
					   ) ;_ end of car
					df (cadrs
					     (vlax-curve-getsecondderiv
					       obj
					       p
					     ) ;_ end of vlax-curve-getsecondderiv
					   ) ;_ end of car 
					p  (if (equal df 0.0 1.0e-010)
					     p
					     (- p (/ f df))
					   ) ;_ end of if
				      ) ;_ end of setq
				    ) ;_ end of while
				  ) ;_ end of lambda
				) ;_ end of function
				(setq p_list
				       ((lambda	(p_lst / rez otr)
					  (setq
					    p_lst (mapcar
						    (function float)
						    (vl-sort (vl-remove-if 'null p_lst)
							     (function <)
						    ) ;_ end of vl-sort
						  ) ;_ end of mapcar
					    rez	  (list (car p_lst))
					  ) ;_ end of setq
					  (while p_lst
					    (setq
					      rez   (if	(cadr p_lst)
						      (append
							rez
							(list
							  (+ (car p_lst)
							     (setq otr (/ (- (cadr p_lst)
									     (car p_lst)
									  ) ;_ end of -
									  10
								       ) ;_ end of /
							     ) ;_ end of setq
							  ) ;_ end of +
							) ;_ end of list
							(mapcar
							  (function
							    (lambda (x)
							      (+ (car p_lst) (* x otr))
							    ) ;_ end of lambda
							  ) ;_ end of function
							  '(2 3 4 5 6 7 8 9)
							) ;_ end of mapcar
							(list (cadr p_lst))
						      ) ;_ end of append
						      (append rez (list (car p_lst)))
						    ) ;_ end of if
					      p_lst (cdr p_lst)
					    ) ;_ end of setq
					  ) ;_ end of while
					  rez
					) ;_ end of lambda
					 (vl-remove-if
					   (function null)
					   (mapcar
					     (function
					       (lambda (x)
						 (vlax-curve-getparamatpoint obj x)
					       ) ;_ end of lambda
					     ) ;_ end of function
					     (setq fpt_list
						    (mapcar
						      (function
							(lambda	(x)
							  (vlax-curve-getclosestpointto
							    obj
							    x
							  ) ;_ end of vlax-curve-getclosestpointto
							) ;_ end of lambda
						      ) ;_ end of function
						      (_kpblc-conv-list-to-3dpoints
							(vlax-safearray->list
							  (vlax-variant-value
							    (vla-get-controlpoints obj)
							  ) ;_ end of vlax-variant-value
							) ;_ end of vlax-safearray->list
						      ) ;_ end of _kpblc-conv-list-to-3dpoints
						    ) ;_ end of mapcar
					     ) ;_ end of setq
					   ) ;_ end of mapcar
					 ) ;_ end of vl-remove-if
				       )
				) ;_ end of setq
			      ) ;_ end of mapcar
			    ) ;_ end of vl-remove-if
			  ) ;_ end of mapcar
			  (list
			    (cadrs (car fpt_list))
			    (cadrs (last fpt_list))
			  ) ;_ end of list
			) ;_ end of append
		 ) ;_ end of setq
		 (list (cons (strcat coord "min")
			     (apply (function min) pt_nul_lst)
		       ) ;_ end of cons
		       (cons (strcat coord "max")
			     (apply (function max) pt_nul_lst)
		       ) ;_ end of cons
		 ) ;_ end of list
	       ) ;_ end of lambda
	     ) ;_ end of function
	     (list car cadr) ;_ for 3D: (list car cadr caddr)
	     (list "X" "Y") ;_ for 3D: (list "X" "Y" "Z")
	   ) ;_ end of mapcar
    ) ;_ end of apply
  ) ;_ end of if
) ;_ end of defun
Замечания и предложения приветствуются!
P.S. Выложенный ранее код не прошел тестирования Исправил, работать стало помедленнее, но корректно.

Последний раз редактировалось Do$, 26.10.2009 в 14:50. Причина: Исключил Fitpoints из расчета - не обрисовывались некоторые сплайны.
Do$ вне форума  
 
Непрочитано 26.10.2009, 15:59
#52
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>Do$
1. На сглаженной полилинии ф-я test выдает
Код:
[Выделить все]
 
Command: test
Select spline:; error: bad DXF group: (10 nil nil)
2.
Цитата:
А вот со сплайном, полученным из сглаженной полилинии не подружилась.
Есть такое дело. Не понятно почему для для сглаженной полилинии не работает такой код:
Код:
[Выделить все]
 
(vlax-curve-getPointAtParam obj (vlax-curve-getEndParam obj))
хотя
Код:
[Выделить все]
 
(vlax-curve-getEndPoint obj)
выдает нужную точку...
Исправленный вариант
Код:
[Выделить все]
(defun rec-boundingBox (/ f test test1 lst obj)
 (setq
  f (lambda (x y)
     (equal
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj x)
      ) ;_  mapcar
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj y)
      ) ;_  mapcar
     ) ;_  equal
    ) ;_  lambda
 ) ;_  setq
 (defun test (a b d)
  (if (= a b)
   nil
   ((lambda (r)
     (if (equal a r d)
      r
      (if (f a r)
       (test r b d)
       (test a r d)
      ) ;_  if
     ) ;_  if
    ) ;_  lambda
    (/ (+ a b) 2.)
   )
  ) ;_  if
 ) ;_  defun
 (defun test1 (a b e / temp lst)
  (setq
   temp (mapcar 'minusp
                (vlax-curve-getFirstDeriv obj a)
        ) ;_  mapcar
  ) ;_  setq
  (while
   (cond
    ((> b e) nil)
    ((equal
      temp
      (mapcar 'minusp
              (vlax-curve-getFirstDeriv obj b)
      ) ;_  mapcar
     ) ;_  equal
     (setq b (1+ b))
    )
    (t
     (setq lst  (cons (test (1- b) b 1.0e-010) lst)
           a    b
           temp (mapcar 'minusp
                        (vlax-curve-getFirstDeriv obj a)
                ) ;_  mapcar
           b    (1+ b)
     ) ;_  setq
    )
   ) ;_  cond
  ) ;_  while
  lst
 ) ;_  defun
 (if
  (and (setq obj
             (car (entsel
                   "\nВыберите pline,spline,ellipse: "
                  ) ;_  entsel
             ) ;_  car
       ) ;_  setq
       (wcmatch (cdr (assoc 0 (entget obj)))
                "SPLINE,ELLIPSE,*LINE,CIRCLE,ARC"
       ) ;_  wcmatch
       (setq obj (vlax-ename->vla-object obj))
  ) ;_ end of and
  ((lambda (lst)
    (list (list (apply 'min (mapcar 'car lst))
                (apply 'min (mapcar 'cadr lst))
          ) ;_  list
          (list (apply 'max (mapcar 'car lst))
                (apply 'max (mapcar 'cadr lst))
          ) ;_  list
    ) ;_  list
   ) ;_  lambda
   (append
    (list (vlax-curve-getStartPoint obj)
          (vlax-curve-getEndPoint obj)
    ) ;_  list
    (mapcar
     '(lambda (x)
       (vlax-curve-getPointAtParam obj x)
      ) ;_  lambda
     (cons 0.0
           (test1 0 1 (vlax-curve-getEndParam obj))
     ) ;_  cons
    ) ;_  mapcar
   ) ;_  append
  )
 ) ;_  if
) ;_  defun
;;;Проверка
(progn
  (vl-cmdf "_rectang")
  (apply 'vl-cmdf (rec-boundingBox))
) ;_ end of progn
CB вне форума  
 
Непрочитано 26.10.2009, 16:22
#53
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Цитата:
Сообщение от CB Посмотреть сообщение
>Do$
1. На сглаженной полилинии ф-я test выдает

Код:

Command: test
Select spline:; error: bad DXF group: (10 nil nil)
да ну ее, эту сглаженную на ней vla-getboundingbox и так корректно работает, поэтому функцию делал только для сплайна: в начале идет проверка, если выбранный объект не сплайн - выдает nil. Ну а вспомогательная программа отрисовки естессна ругается, что вместо координат nil получает.
Do$ вне форума  
 
Автор темы   Непрочитано 02.11.2009, 15:22
#54
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


А рабочая версия программы для распечатки по объекту уже есть или как?
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 02.11.2009, 17:12
#55
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Все наработки этой темы скидал в кучу, особо не проверял (Нужно заменить <Имя устройства вывода> на свой принтер, после загрузки запускать командой object_print):
Код:
[Выделить все]
(defun c:object_print (/ ent box xy1 xy2 orientation a)

  (defun GetBoundingBox	(en / obj minpt maxpt)
    (if	(= (type en) 'ENAME)
      (progn
	(setq obj (vlax-ename->vla-object en))
	(vla-getboundingbox obj 'minpt 'maxpt)
	(list
	  (trans (vlax-safearray->list minpt) 0 1)
	  (trans (vlax-safearray->list maxpt) 0 1)
	) ;_ end of list
      ) ;_ end of progn
    ) ;_endof if progn 
  ) ;_endof defun

  (defun GetBoundingBox_dynblock (ent / lst min_point max_point)
;;;  (if (and (= (type (setq ent (vl-catch-all-apply
;;;                                (function
;;;                                  (lambda ()
;;;                                    (car (entsel "\nБлок <Отмена> : "))
;;;                                    ) ;_ end of lambda
;;;                                  ) ;_ end of function
;;;                                ) ;_ end of vl-catch-all-apply
;;;                          ) ;_ end of setq
;;;                    ) ;_ end of type
;;;              'ename
;;;              ) ;_ end of =
    (setq ent (vlax-ename->vla-object ent))
;;;           (vlax-property-available-p ent 'isdynamicblock)
;;;           (equal (vla-get-isdynamicblock ent) :vlax-true)
;;;           ) ;_ end of and
;;;  (progn
    (vlax-for item
	      (vla-item	(vla-get-blocks
			  (vla-get-activedocument (vlax-get-acad-object))
			) ;_ end of vla-get-blocks
			(vla-get-name ent)
	      ) ;_ end of vla-item
      (if (equal (vla-get-visible item) :vlax-true)
	(setq lst (cons item lst))
      ) ;_ end of if
    ) ;_ end of vlax-for
    (setq lst	    (vl-remove
		      nil
		      (mapcar
			(function
			  (lambda (x / minp maxp)
			    (if	(not (vl-catch-all-error-p
				       (vl-catch-all-apply
					 (function
					   (lambda ()
					     (vla-getboundingbox x 'minp 'maxp)
					   ) ;_ end of lambda
					 ) ;_ end of function
				       ) ;_ end of vl-catch-all-apply
				     ) ;_ end of vl-catch-all-error-p
				) ;_ end of not
			      (list (cons "min" (vlax-safearray->list minp))
				    (cons "max" (vlax-safearray->list maxp))
			      ) ;_ end of list
			    ) ;_ end of if
			  ) ;_ end of lambda
			) ;_ end of function
			lst
		      ) ;_ end of mapcar
		    ) ;_ end of vl-remove
	  min_point (mapcar
		      (function +)
		      (mapcar
			(function
			  (lambda (f)
			    (apply
			      (function min)
			      (mapcar f
				      (mapcar
					(function
					  (lambda (x) (cdr (assoc "min" x)))
					) ;_ end of function
					lst
				      ) ;_ end of mapcar
			      ) ;_ end of mapcar
			    ) ;_ end of apply
			  ) ;_ end of lambda
			) ;_ end of function
			(list 'car 'cadr 'caddr)
		      ) ;_ end of mapcar
		      (vlax-safearray->list
			(vlax-variant-value (vla-get-insertionpoint ent))
		      ) ;_ end of vlax-safearray->list
		    ) ;_ end of mapcar
	  max_point (mapcar
		      (function +)
		      (mapcar
			(function
			  (lambda (f)
			    (apply
			      (function max)
			      (mapcar f
				      (mapcar
					(function
					  (lambda (x) (cdr (assoc "max" x)))
					) ;_ end of function
					lst
				      ) ;_ end of mapcar
			      ) ;_ end of mapcar
			    ) ;_ end of apply
			  ) ;_ end of lambda
			) ;_ end of function
			(list 'car 'cadr 'caddr)
		      ) ;_ end of mapcar
		      (vlax-safearray->list
			(vlax-variant-value (vla-get-insertionpoint ent))
		      ) ;_ end of vlax-safearray->list
		    ) ;_ end of mapcar
;;;            lst       (list (cons "min" min_point) (cons "max" max_point))
	  lst	    (list min_point max_point)
    ) ;_ end of setq
;;;  ) ;_ end of progn
;;;) ;_ end of if
;;;lst
  ) ;_ end of defun



  (defun Spline_getBoundingBox (obj	    /		c_pt_lst
				cd_pt_lst   ex_pt_lst	cls_pt_lst
				p_lst	    divid	spline_extr
			       )


    (defun spline_extr (obj pst / it)
		       ;|
Функция поиска экстремума сплайна на основе метода Ньютона.
Исходные параметры:
 obj - VLA-OBJECT или ENAME вида: #<VLA-OBJECT IAcadSpline 05548644> или <Entity name: 7ef65fb8>
 pst - параметр сплайна в точке начального приближения к экстремуму, действительное число

Возвращаемые значения:
 Список вида: (параметр1 параметр2 параметр3)
 параметр 1(2,3) может быть действительным положительным числом или nil, если экстремум
 не был найден (метод не сошелся).
 Примеры: (137.199 173.728 147.543)
	  (nil nil 219.258)

Пример вызова:
(spline_extr
  (setq	obj
	 (vlax-ename->vla-object
	   (car (entsel "\nВыберите сплайн:"))
	 ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq
  (vlax-curve-getParamAtPoint
    obj
    (getpoint "\nУкажите точку на сплайне:")
  ) ;_ end of vlax-curve-getParamAtPoint
) ;_ end of spline_extr
|;
      (if pst
	(mapcar
	  (function
	    (lambda (cadrs / f df p)
	      (setq it 0
		    p  pst
	      ) ;_ end of setq
	      (while (not (or (equal f 0.0 1.0e-008)
			      (equal df 0.0 1.0e-008)
			      (> it 10)
			  ) ;_ end of or
		     ) ;_ end of not
		(setq it (1+ it)
		      f	 ((eval cadrs) (vlax-curve-getfirstderiv obj p))
		      df ((eval cadrs) (vlax-curve-getsecondderiv obj p))
		      p	 (if (equal df 0.0 1.0e-008)
			   p
			   (- p (/ f df))
			 ) ;_ end of if
		) ;_ end of setq
	      ) ;_ end of while
	      (if (or (< p (vlax-curve-getStartParam obj))
		      (> p (vlax-curve-getEndParam obj))
		      (> it 10)
		  ) ;_ end of or
		nil
		p
	      ) ;_ end of if
	    ) ;_ end of lambda
	  ) ;_ end of function
	  (list car cadr caddr)
	) ;_ end of mapcar
      ) ;_ end of if
    ) ;_ end of defun

    (defun divid (pt1 pt2 n)
		 ;|
    Функция нахождения точек, делящих отрезок
    на заданное количество равных частей.

Исходные параметры:
    pt1 - начало отрезка
    pt2 - конец отрезка
    n - количество частей

Пример вызова:
    (divid '(0.0 0.0 0.0) '(15.0 15.0 15.0) 3)
    (divid '(0.0 0.0) '(12.0 12.0) 4)

Возвращаемое значение - список точек вида:
    ((5.0 5.0 5.0) (10.0 10.0 10.0))
    ((3.0 3.0) (6.0 6.0) (9.0 9.0))
|;
      (mapcar
	'(lambda (c)
	   (mapcar '(lambda (a b) (+ (* c (/ (- a b) n)) b)) pt2 pt1)
	 ) ;_ end of lambda
	(
	 (lambda (d / rez)
	   (repeat (setq d (1- d))
	     (setq rez (cons d rez)
		   d   (1- d)
	     ) ;_ end of setq
	   ) ;_ end of repeat
	   rez
	 ) ;_ end of lambda
	  n
	)
      ) ;_ end of mapcar
    ) ;_ end of defun

    (if	(= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of if
    (setq c_pt_lst   (mapcar
		       '(lambda	(x)
			  (vlax-safearray->list
			    (vlax-variant-value
			      (vla-getcontrolpoint obj x)
			    ) ;_ end of vlax-variant-value
			  ) ;_ end of vlax-safearray->list
			) ;_ end of lambda
		       (
			(lambda	(/ n lst)
			  (repeat
			    (1-	(setq
				  n (1- (vla-get-NumberOfControlPoints obj))
				) ;_ end of setq
			    ) ;_ end of 1-
			     (setq
			       n   (1- n)
			       lst (cons n lst)
			     ) ;_ end of setq
			  ) ;_ end of repeat
			  lst
			) ;_ end of lambda
		       )
		     ) ;_ end of mapcar


	  cd_pt_lst  (
		      (lambda (lst / rez)
			(while lst
			  (if (cadr lst)
			    (setq
			      rez (append
				    rez
				    (cons (car lst)
					  (divid (car lst) (cadr lst) 3)
				    ) ;_ end of cons
				  ) ;_ end of append
			    ) ;_ end of setq
			    (setq rez (append rez lst))
			  ) ;_ end of if
			  (setq lst (cdr lst))
			) ;_ end of while
			rez
		      ) ;_ end of lambda
		       c_pt_lst
		     )
	  cls_pt_lst (mapcar
		       '(lambda	(pt)
			  (vlax-curve-getclosestpointto obj pt)
			) ;_ end of lambda
		       cd_pt_lst
		     ) ;_ end of mapcar
	  p_lst	     (vl-remove-if
		       'not
		       (apply
			 'append
			 (mapcar (function (lambda (x)
					     (spline_extr
					       obj
					       (vlax-curve-getParamAtPoint obj x)
					     ) ;_ end of spline_extr
					   ) ;_ end of lambda
				 ) ;_ end of function
				 cls_pt_lst
			 ) ;_ end of mapcar
		       ) ;_ end of apply
		     ) ;_ end of vl-remove-if
	  ex_pt_lst  (append
		       (list
			 (vlax-curve-getStartPoint obj)
			 (vlax-curve-getEndPoint obj)
		       ) ;_ end of list
		       (mapcar
			 (function
			   (lambda (p) (vlax-curve-getPointAtParam obj p))
			 ) ;_ end of function
			 p_lst
		       ) ;_ end of mapcar
		     ) ;_ end of append
    ) ;_ end of setq
    (mapcar
      (function
	(lambda	(mins)
	  (mapcar
	    (function (lambda (cadrs)
			(apply (function mins)
			       (mapcar (function cadrs) ex_pt_lst)
			) ;_ end of apply
		      ) ;_ end of lambda
	    ) ;_ end of function
	    (list car cadr caddr)
	  ) ;_ end of mapcar
	) ;_ end of lambda
      ) ;_ end of function
      (list min max)
    ) ;_ end of mapcar
  ) ;_ end of defun


;;;(princ "Выберите объект для печати")
;;;(setq box (GetBoundingBox (car (entsel))))
  (vl-load-com)
  (vla-StartUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-StartUndoMark
  (if (= (type (setq ent
		      (vl-catch-all-apply
			(function
			  (lambda ()
			    (car
			      (entsel "\nВыберите объект для печати <Отмена> : ")
			    ) ;_ end of car
			  ) ;_ end of lambda
			) ;_ end of function
		      ) ;_ end of vl-catch-all-apply
	       ) ;_ end of setq
	 ) ;_ end of type
	 'ename
      ) ;_ end of =
    (progn
      (cond
	((and
	   (= (cdr (assoc 0 (entget ent))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ent)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ent))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (setq box (GetBoundingBox_dynblock ent))
	)
	((= (cdr (assoc 0 (entget ent))) "SPLINE")
	 (setq box (Spline_getBoundingBox ent))
	)
	(T (setq box (GetBoundingBox ent)))
      ) ;_ end of cond




					; список из координат минимума и максимума габаритов выбранного объекта
      (setq xy1 (car box))		; координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя 
      (setq xy2 (car (cdr box)))
      (setq a (angle xy1 xy2))		;угол для вычисления ориентации листа
;;; Ориентация листа: если угол в диапазоне 45...135 или 225...315 то портрет, иначе - альбом
      (if (or (and (> a (* pi 0.25)) (< a (* pi 0.75)))
	      (and (> a (* pi 1.25)) (< a (* pi 1.75)))
	  ) ;_ end of or
	(setq orientation "Portrait")
	(setq orientation "Landscape")
      ) ;_ end of if
      (command "_.plot"	       "_Yes"	       "model"
					; Имя листа или [?] <Модель>: 
	       "<Имя устройства вывода>.pc3" ;Имя устройства вывода 
	       "A4"			;Формат листа бумаги
	       "Millimeters"		;Единицы измерения размеров листа
	       orientation		;Ориентация чертежа
	       "_No"			;Перевернуть чертеж?
	       "_Window"		;Печатаемая область
	       xy1			;Первая точка окна 
	       xy2			;Вторая точка окна 
	       "_fit"			;[Вписать]
	       "_center"		;Смещение от начала (x,y) или [Центрировать]
	       "_yes"			;Учитывать стили печати?
	       "monochrome.ctb"		;Имя таблицы стилей печати
	       "_yes"			;Учитывать веса линий?
	       "As displayed"		;Режим вывода раскрашенных ВЭ
	       "_No"			;Запись чертежа в файл
	       "_yes"			;Сохранить изменения параметров листа
	       "_yes"			;Перейти к печати
	      ) ;_ end of command
 ;_ end of command
 ;_ end of command
    ) ;_ end of progn
  ) ;_ end of if
  (vla-EndUndoMark
    (vla-get-ActiveDocument (vlax-get-acad-object))
  ) ;_ end of vla-EndUndoMark
) ;_ end of defun
Do$ вне форума  
 
Автор темы   Непрочитано 03.11.2009, 15:38
#56
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


Спасибо тебе добрый человек
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 06.11.2009, 12:36 мой код для печати по дин блокам
#57
Колька


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


Парни я честно говоря не вник о чём писали ранее, поэтому извените если повторился в чём то. Вот мой код для печати по динамическим блокам из 2-х точек. У меня всё работает. Первые 2 функции для отображения этих самых точек, последние (px и py) вспомогательные. Основной код NPr. Покритикуйте плиз, хочеться оптимизировать свой процесс програмирования

Блок с точками:
Print_block.dwg

Код:
[Выделить все]
 
(defun C:NPointV (/)
	(if (/= (getvar "_pdmode") 35) (setvar "_pdmode" 35))
	(if (/= (getvar "_pdsize") -1) (setvar "_pdsize" -1))
)
(defun C:NPointInv (/)
	(if (/= (getvar "_pdmode") 0) (setvar "_pdmode" 0))
	(if (/= (getvar "_pdsize") 0) (setvar "_pdsize" 0))
)

(defun C:NPr ( / i nabor text x y p1 p2 obj)
	(vl-load-com)	
	(command "_ucs" "_world")
	(setq nabor (ssget '((0 . "INSERT"))))
	(setq i (- (sslength nabor) 1))
	(while (>= i 0)
		(setq text (vlax-get-property (vlax-ename->vla-object (ssname nabor i)) 'EffectiveName))
		(if (/= text "Ramka_dlya_pechati") (ssdel (ssname nabor i) nabor))
		(setq i (- i 1))
	)	
	(setq i 0)	
	(while (< i (sslength nabor))		
		(setq obj (vlax-ename->vla-object (ssname nabor i)))
		(setq p1 (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'InsertionPoint))))		
		(setq x (vlax-variant-value (vlax-get-property (car (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj)))) 'value)))
                      (setq y (vlax-variant-value (vlax-get-property (car (cdr (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties obj))))) 'value)))
		(setq p2 (py y (px x p1) ) )		
		(if (> x y) (setq text "Landscape") (setq text "Portrait"))
		(command "_plot" "_y" "" "ВАШ ПРИНТЕР" "A3" "_Millimeters" text "_No" "_Window" p1 p2
		"_Fit" "_center" "_Yes" "monochrome.ctb" "_Yes" "_As displayed" "_N" "_N" "_Y")
		(setq i (+ i 1))	
	)	
)

	(defun px (x pt) (cons (+ x (nth 0 pt)) (cons (nth 1 pt) (cons (nth 2 pt) (cdddr pt)))))
	(defun py (y pt) (cons (nth 0 pt) (cons (+ y (nth 1 pt)) (cons (nth 2 pt) (cdddr pt)))))
Кстати она отличаеться тем что расставив блоки по всем чертежам можно не заморачиваясь выделить их все и распечатать, прога сама отыщет блоки.

Последний раз редактировалось Колька, 06.11.2009 в 14:45. Причина: переделал для российского пользователя
Колька вне форума  
 
Непрочитано 06.11.2009, 13:38
#58
Кулик Алексей aka kpblc
Moderator

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


Проблема номер раз: не будет работать в официальных локализациях.
Проблема номер два: печать сделана под определенный плоттер и на другой машине, скорее всего, работать не будет.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 06.11.2009, 13:45
#59
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,825
<phrase 1=


Колька код из поста 55 печатает по выбору объекта пример см пост 1. То бишь просто выбираешь объект, а прога определяет сама границы печати и отправляет на принтер. Все настройки делаются в самой программе, тама все понятно.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 06.11.2009, 13:46
#60
Колька


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


В русской версии не пробовал, но думаю нижние слеши спасут. А насчёт определённого плоттера, так ведь здесь все пишут под определённый, там где нужно поменять так и написанно "ВАШ ПРИНТЕР". Да кстати там же можно и бумагу менять и др. параметры.

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

Ладно, не понравилась так фиг с ней. У меня по этой теме вопрос. Кто нибудь знает как вытащить имена принтеров в лиспе? А то при установки проги приходиться их вручную забивать.

Последний раз редактировалось Колька, 06.11.2009 в 13:51. Причина: прочитал дальше:)
Колька вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Печать из модели по выбору объекта

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Опять про печать из модели нескольких листов gizmo_zx Программирование 2 28.09.2010 12:33
Автоматическая печать из пространства модели Дмитрий_В AutoCAD 9 19.04.2006 16:52
Печать из модели Eugenius AutoCAD 11 03.11.2004 18:26
Печать 3-х мерной модели Лариса AutoCAD 5 09.06.2004 19:57