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

zenon · 21.10.2009, 12:41

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

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

исходник.dwg

zenon · 26.11.2009, 10:25

Do$, прожка нормально работает, как и упоминал поворот блока и атрибуты не обрабатываются.
ps А вот поворот Мтекста отлично обрабатывается.
pss а можно запрос при выборе

Цитата:

Укажите объект для печати, или:[Несколько/ Блок]

повесить на правую кнопку мыши?

Do$ · 26.11.2009, 20:46

Цитата:

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

ps А вот поворот Мтекста отлично обрабатывается.

Я думаю, что если глубже копнуть, то с мтекстом будут нелады. Например, если междустрочный интервал увеличить...
Не совсем понял насчет правой кнопки мыши. Сделать контекстное меню при нажатии ПКМ из пунктов "Несколько" и "Блок"? А не проще дин. ввод включить?

zenon · 27.11.2009, 09:48

Цитата:

Сообщение от Do$

А не проще дин. ввод включить?

три движения лишних
переключить язык
ввести букву
нажать ентер
да и привык уже к ПКМ,автоматом жму. ан нет

Do$ · 27.11.2009, 10:16

При дин. вводе можно пункты выбирать мышкой (см. рис.).
Если динамический ввод принципиально не нравится - тогда не обязательно язык переключать, команды дублируются на английском:
"Несколько": _m (_Multy)
"Блок": _b (_Block)
"Имя": _n (_Name)
Как контекстное меню на ПКМ повесить пока не представляю. Предполагаю, что нужно делать реактор на это событие, а дальше -

.
Если б был какой-то пример программы на LISP с обработкой нажатия ПКМ и выводом контекстного меню...

А попроще - может написать макрокоманду и повесить на кнопку?

Djur · 11.02.2010, 11:29

Круто!!! Очень Благодарен, за кучу сэкономленного времени)))))))))
А можно, пожалуйста, получить последние изменения, там где с дин. вводом?

))

Do$ · 12.02.2010, 09:03

В сообщении #120 последняя на данный момент версия!
Динамический ввод - это не "фишка" программы, это режим самого автокада (включается и выключается нажатием F12)

Nikolay 2 · 04.03.2010, 11:48

Цитата:

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

Можно ли как-нибудь одновременно (при одном запуске проги) печатать несколько форматов листов (например А3 и А4)?
Т.е. запускаешь прогу и выделяешь лист формата А3 и лист формата А4, и прога печатает лист А3 и лист А4.
Было бы здорово чтобы прога умела сама определять нужный формат листа по соотношению сторон этого листа (при условии, что сам лист начерчен правильно: т.е. А4=210х297, или 2100х2970 и т.п.)

Это действительно было бы то, что "врач прописал". Do$, такое возможно сделать, а то печатать приходится из файла где куча форматов от А4 до А1. Хотя, даже то что уже есть, значительно облегчает процесс печати, и за это спасибо.

Do$ · 04.03.2010, 11:55

Пожалуйста!
Будет время - поколдую. Пока недосуг.

Do$ · 10.03.2010, 16:11

Опишу как я себе это представляю:
Получается, что программа должна сама определять мало того, что формат листа, так еще и принтер, куда нужно печатать. Ведь вряд ли кто-то печатает А4 и А3 на плоттере, а А1 и А0 на принтере. То есть надо будет сделать предварительную настройку: для каждого формата задать принтер/плоттер, формат/размер листа в форме диалога.
Далее, четко размеры выдерживать не стоит. Мне думается, что все, что по размерам входит в габарит 297х210*1.5 печатать на А4, далее - от 297х210*1.5 до 420х297*1.5 печатать на А3 и т.д. То есть в любом случае на чем-нибудь напечатается.
Разграничение форматов по габаритам:
до 297х210*1.5 - А4
от 297х210*1.5 до 420х297*1.5 - А3
от 420х297*1.5 до 594х420*1.5 - А2
от 594х420*1.5 до 840х594*1.5 - А1
свыше 840х594*1.5 - А0

Nikolay 2 · 11.03.2010, 14:25

Цитата:

Сообщение от Do$

То есть надо будет сделать предварительную настройку: для каждого формата задать принтер/плоттер, формат/размер листа в форме диалога.

В принципе об этом шла речь... Типа, выбираем чертежи формата А4 и устанавливаем для них принтер ХХ, затем выбираем чертежи формата А3 и для них назначаем принтер ХХ и т.д.

ssn · 12.03.2010, 15:43

давно делал такое на ВБА. именно сначало задаём что и где печатаем, а уже потом все разносится по принтерам само в зависимости от размера форматки.
http://dwg.ru/dnl/126
работает и сейчас на ура.

Nikolay 2 · 15.03.2010, 08:54

Цитата:

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

Давно делал такое на ВБА. именно сначало задаём что и где печатаем, а уже потом все разносится по принтерам само в зависимости от размера форматки.
http://dwg.ru/dnl/126
работает и сейчас на ура.

А где найти кнопку печати? Загружается 12 панелей, но такой кнопки нет....

ssn · 15.03.2010, 20:49

http://forum.abok.ru/index.php?showtopic=28075
в последнем посте есть немного видео по макросу

Nikolay 2 · 16.03.2010, 08:00

Исторически сложилось так, что чертежи делаются в модели и оформляются СПДС GraphiCS, поэтому данная программа не подходит. Ждем результатов танцев с бубном от Do$, а пока используем лисп из #120

ssn · 16.03.2010, 17:33

на самом деле

если нарисовать саму форматку в листе, а потом её вставить в модель... все работает. просто так же исторически... в модели лежит модель... в листах сами чертежи. что бы не было соблазна у сослуживцев

а если ещё точнее... то поиск формата происходит по объёкту полилиния на слое 0 и со скейл фактором 211175. любой объект подошедший под описание рассматривается как лист. потом с него просто берутся габаритные размеры и посылаются на принтер, которому данные размеры сопоставлены. при настройке программа просто редактирует пейдж сетап (всмысле человек его редактирует как надо), потом ему присваивается имя понятное программе, и потом она посылает лист на печать с настройками этого пейдж сетапа меняя лишь граници печатаемой области для каждого нового листа
т.е. если рамку сделать полилинией как надо... то впринципе, рисовать форматки программой не обязательно. так же понятно, что области печати можно просто копировать
единственно, что у меня не получилось сделать совсем красиво, это надо при настройке вручную создавать этот пейд сетап с именем 1. вероятно можно победить, и скорее всего не так сложно, но... почему то у меня не получилось.
а так, один раз в шаблон сохраняем все принтеры, и каждый новый файл уже настроен и все листы посылаются куда надо

JokerrSergh · 06.05.2010, 10:14

Цитата:

Сообщение от Do$

Лечится, только сразу не смогу сказать как. Подумать надо.
Обновление:
Вопрос масштаба решил. Поворот и атрибуты пока не трогал (может и не буду). По идее, с немировой системой координат тоже проблем не должно быть.

Код:

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

(defun c:easyplot (/		     MGetBoundingBox
		   plotter-format-dialog
		   Table	     _dwgru-conv-pickset-to-list
		   ent		     ss
		   str		     adoc
		   box		     lay
		   plot_paper_name   plot
		  )

  (defun MGetBoundingBox (ename			 /
			  GetBoundingBox	 GetBoundingBox_dynblock
			  Spline_getBoundingBox
			 )

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


    (defun GetBoundingBox_dynblock
	   (ent / lst ins_pt min_point max_point 3d_polarp)
	   ;|
(entmakex
  (cons	'(0 . "LINE")
	(mapcar 'cons '(10 11) (getboundingbox_dynblock nil))
  ) ;_ end of append
) ;_ end of entmakex
|;
      (if
	(and (or ent
		 (= (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 =
	     ) ;_ end of or
	     (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
	     ins_pt (vlax-safearray->list
		      (vlax-variant-value
			(vla-get-insertionpoint ent)
		      ) ;_ end of vlax-variant-value
		    ) ;_ end of vlax-safearray->list
	     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
	     lst    (mapcar
		      (function
			(lambda	(mins)
			  (mapcar
			    (function
			      (lambda (fun)
				(apply
				  (read mins)
				  (mapcar
				    (function fun)
				    (mapcar
				      (function
					(lambda	(pts)
					  (cdr (assoc mins pts))
					) ;_ end of lambda
				      ) ;_ 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
			) ;_ end of lambda
		      ) ;_ end of function
		      (list "min" "max")
		    ) ;_ end of mapcar
	     lst    (mapcar
		      (function
			(lambda	(ept)
			  (mapcar
			    (function
			      (lambda (coord_pt coord_line coord_ins)
				(+
				  (*
				    coord_pt
				    ((eval
				       (read (strcat "vla-get-"
						     coord_line
						     "EffectiveScaleFactor"
					     ) ;_ end of strcat
				       ) ;_ end of read
				     ) ;_ end of eval
				      ent
				    )
				  ) ;_ end of *
				  coord_ins
				) ;_ end of +
			      ) ;_ end of lambda
			    ) ;_ end of function
			    ept
			    '("X" "Y" "Z")
			    ins_pt
			  ) ;_ end of mapcar
			) ;_ end of lambda
		      ) ;_ end of function
		      lst
		    ) ;_ end of mapcar
	   ) ;_ end of setq
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ 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

    (mapcar
      (function	(lambda	(a)
		  (mapcar (function (lambda (b)
				      (if (equal b 0.0 1.0e-007)
					0.0
					b
				      ) ;_ end of if
				    ) ;_ end of lambda
			  ) ;_ end of function
			  a
		  ) ;_ end of mapcar
		) ;_ end of lambda
      ) ;_ end of function
      (cond
	((and
	   (= (cdr (assoc 0 (entget ename))) "INSERT")
	   (vlax-property-available-p
	     (vlax-ename->vla-object ename)
	     'isdynamicblock
	   ) ;_ end of vlax-property-available-p
	   (equal (vla-get-isdynamicblock (vlax-ename->vla-object ename))
		  :vlax-true
	   ) ;_ end of equal
	 ) ;_ end of and
	 (GetBoundingBox_dynblock ename)
	)
	((= (cdr (assoc 0 (entget ename))) "SPLINE")
	 (Spline_getBoundingBox ename)
	)
	(T (GetBoundingBox ename))
      ) ;_ end of cond
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun plotter-format-dialog
			       (lay	      /
				easyplot-action-fun
				run_dialog    fo
				fn	      plot_names
				paper_name
			       )

    (defun easyplot-action-fun (key value data reason x y)
      (cond
	((= key "plot_names")
	 (setq plot_name (nth (atoi value) plot_names))
	 (done_dialog 2)
	)
	((= key "accept")
	 (setq paper_name
		(cdr
		  (nth (atoi (get_tile "paper_names")) paper_names)
		) ;_ end of cdr
	 ) ;_ end of setq
	 (done_dialog 1)
	)
	((= key "cancel") (setq paper_name 0) (done_dialog 3))
      ) ;_ end of cond
    ) ;_ end of defun

    (defun run_dialog (file dlg rexp action / dl1)
      (if (and (= (type file) (type dlg) 'STR)
	       (= (type rexp) 'LIST)
	  ) ;_ end of and
	(if (> (setq dl1 (load_dialog file)) 0)
	  (progn
	    (if	(new_dialog dlg dl1 action)
	      (progn
		(if
		  (vl-catch-all-error-p (vl-catch-all-apply rexp))
		   (progn
		     (princ "\nОшибка в выражении!")
		     (term_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		   (progn
		     (start_dialog)
		     (unload_dialog dl1)
		   ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (alert
		(strcat
		  "В файле: \""		     file
		  "\"\nне найдено описания диалога:\n\""
		  dlg			     "\""
		 ) ;_ end of strcat
	      ) ;_ end of alert
	    ) ;_ end of if
	  ) ;_ end of progn
	  (alert (strcat "Файл: \"" file "\" не найден!"))
	) ;_ end of if
      ) ;_ end of if
    ) ;_ end of defun

    (setq
      plot_names (vl-sort
		   (vl-remove-if
		     '(lambda (a)
			(or (= (strcase a T) "none")
			    (wcmatch a "*.pc3")
			) ;_ end of or
		      ) ;_ end of lambda
		     (vlax-safearray->list
		       (vlax-variant-value (vla-GetPlotDeviceNames lay))
		     ) ;_ end of vlax-safearray->list
		   ) ;_ end of vl-remove-if
		   '<
		 ) ;_ end of vl-sort
      plot_name	 (car plot_names)
      fn	 (vl-filename-mktemp "objpr" nil ".dcl")
      fo	 (open fn "w")
    ) ;_ end of setq
    (write-line
      (strcat
	"print_device:dialog{label=\"Выбор устройства печати       \";"
	":column {:text{label=\"Выберите принтер или плоттер:\";}:popup_list{key=\"plot_names\";}"
	":text{label=\"Выберите формат/размер листа:\";}:popup_list{key=\"paper_names\";}}ok_cancel;}"
      ) ;_ end of strcat
      fo
    ) ;_ end of write-line
    (close fo)
    (while (not paper_name)
      (run_dialog
	fn
	"print_device"
	(function
	  (lambda ()
	    (start_list "plot_names")
	    (mapcar 'add_list
		    plot_names
	    ) ;_ end of mapcar
	    (end_list)
	    (set_tile "plot_names"
		      (itoa (vl-position plot_name plot_names))
	    ) ;_ end of set_tile
	    (vla-put-ConfigName lay plot_name)
	    (setq paper_names
		   (vl-sort
		     (vl-remove-if
		       '(lambda	(y)
			  (wcmatch (car y) "*Inches*,*Pixels*,~*A#*")
			) ;_ end of lambda
		       (mapcar
			 '(lambda (c)
			    (cons (vla-GetLocaleMediaName lay c) c)
			  ) ;_ end of lambda
			 (vlax-safearray->list
			   (vlax-variant-value
			     (vla-GetCanonicalMediaNames lay)
			   ) ;_ end of vlax-variant-value
			 ) ;_ end of vlax-safearray->list
		       ) ;_ end of mapcar
		     ) ;_ end of vl-remove-if
		     '(lambda (a b) (< (car a) (car b)))
		   ) ;_ end of vl-sort
	    ) ;_ end of setq
	    (start_list "paper_names")
	    (mapcar '(lambda (a) (add_list (car a)))
		    paper_names
	    ) ;_ end of mapcar
	    (end_list)
	  ) ;_ end of lambda
	) ;_ end of function
	"(easyplot-action-fun  $key $value $data $reason $x $y)"
      ) ;_ end of run_dialog
    ) ;_ end of while
    (vl-file-delete (findfile fn))
    (if	(and (= (type paper_name) 'STR) (/= (strlen paper_name) 0))
      (progn
	(vla-put-CanonicalMediaName lay paper_name)
	(list plot_name paper_name)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



  (defun Table (s / d r)
	       ;|
Взято с dwg.ru
written by Michael Puckett.
Вызов
(table "style")
(table "layer")
|;
    (while (setq d (tblnext s (null d)))
      (setq r (append r (list (cdr (assoc 2 d)))))
    ) ;_ end of while
  ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

  (vl-load-com)
  (setq	adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	lay  (vla-get-ActiveLayout adoc)
	plot (vla-get-plot adoc)
  ) ;_ end of setq
  (if (ssget "_X" (list (cons 410 (getvar "ctab"))))
    (progn
      (while (not ent)
	(setq ent
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (initget "Несколько Блок _Multy Block")
		     (entsel
		       "\nУкажите объект для печати, или:[Несколько/ Блок]"
		     ) ;_ end of getkword
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(cond
	  ((not ent) (princ "\nНичего не указано!"))
	  ((vl-catch-all-error-p ent) (setq ent "exit"))
	  ((and (listp ent) (= (type (car ent)) 'ENAME))
	   (setq ent (list (car ent)))
	  )
	  (;|(and (= (type ent) 'STR)|;
	   (= ent "Multy")		;)
	   (setq
	     ss	(vl-catch-all-apply
		  (function (lambda ()
			      (princ "\nВыберите объекты для печати:")
			      (ssget)
			    ) ;_ end of lambda
		  ) ;_ end of function
		) ;_ end of vl-catch-all-apply
	   ) ;_ end of setq
	   (cond
	     ((not ss) (princ "\nНичего не выбрано!"))
	     ((vl-catch-all-error-p ss) (setq ent "exit"))
	     (T
	      (setq ent (_dwgru-conv-pickset-to-list ss))
	     )
	   ) ;_ end of cond
	  )
	  ((and (= (type ent) 'STR) (= ent "Block"))
	   (if
	     (ssget "_X"
		    (list (cons 0 "INSERT") (cons 410 (getvar "ctab")))
	     ) ;_ end of ssget
	      (progn
		(setq ent nil)
		(while (or (not ent) (= ent "Name"))
		  (if (/= ent "Name")
		    (setq ent
			   (vl-catch-all-apply
			     (function
			       (lambda ()
				 (initget "Имя _Name")
				 (entsel "\nУкажите блок для образца, или:[Имя]"
				 ) ;_ end of entsel
			       ) ;_ end of lambda
			     ) ;_ end of function
			   ) ;_ end of vl-catch-all-apply
		    ) ;_ end of setq
		  ) ;_ end of if
		  (cond
		    ((not ent) (princ "\nНичего не выбрано!"))
		    ((vl-catch-all-error-p ent) (setq ent "exit"))
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (setq
		       ent
			(vl-remove-if
			  (function
			    (lambda (a)
			      (/= (vla-get-EffectiveName
				    (vlax-ename->vla-object a)
				  ) ;_ end of vla-get-EffectiveName
				  (vla-get-EffectiveName
				    (vlax-ename->vla-object (car ent))
				  ) ;_ end of vla-get-EffectiveName
			      ) ;_ end of /=
			    ) ;_ end of lambda
			  ) ;_ end of function
			  (_dwgru-conv-pickset-to-list
			    (ssget "_X"
				   (list (cons 0 "INSERT")
					 (assoc 410 (entget (car ent)))
				   ) ;_ end of list
			    ) ;_ end of ssget
			  ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of vl-remove-if
		     ) ;_ end of setq
		    )
		    ((and (listp ent)
			  (= (type (car ent)) 'ENAME)
			  (/= (cdr (assoc 0 (entget (car ent)))) "INSERT")
		     ) ;_ end of and
		     (princ "\nВыбранное не является блоком!")
		    )
		    ((= ent "Name")
		     (setq str
			    (vl-catch-all-apply
			      (function
				(lambda	()
				  (initget "?")
				  (getstring T "\nВведите имя блока, или:[?]")
				) ;_ end of lambda
			      ) ;_ end of function
			    ) ;_ end of vl-catch-all-apply
		     ) ;_ end of setq
		     (cond
		       ((vl-catch-all-error-p str) (setq ent "exit"))
		       ((= str "?")
			(princ "\nЧертеж содержит следующие блоки:")
			(foreach a (vl-sort (Table "Block") '<)
			  (princ (strcat "\n\"" a "\""))
			) ;_ end of foreach
			(TextPage)
		       )
		       ((and (tblsearch "Block" str)
			     (setq
			       ss (ssget "_X"
					 (list (cons 0 "INSERT")
					       (cons 2 str)
					       (cons 410 (getvar "ctab"))
					 ) ;_ end of list
				  ) ;_ end of ssget
			     ) ;_ end of setq
			) ;_ end of and
			(setq
			  ent
			   (_dwgru-conv-pickset-to-list
			     ss
			   ) ;_ end of _dwgru-conv-pickset-to-list
			) ;_ end of setq
		       )
		       (T
			(princ
			  "\nБлока с таким именем в текущей вкладке нет!"
			) ;_ end of princ
		       )
		     ) ;_ end of cond
		    )
		  ) ;_ end of cond
		) ;_ end of while
	      ) ;_ end of progn
	      (progn
		(setq ent nil)
		(princ "\nТекущая вкладка не содержит блоков!")
	      ) ;_ end of progn
	   ) ;_ end of if
	  ) ;_ end of cond
	) ;_ end of cond
      ) ;_ end of while
      (if
	(and
	  (not (and (= (type ent) 'STR) (= ent "exit")))
	  (setq plot_paper_name (plotter-format-dialog lay))
	) ;_ end of and
	 (progn
	   (mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
		   (list
		     (cons "PlotType" acDisplay)
		     (cons "CenterPlot" :vlax-true)
		     (cons "PaperUnits" acMillimeters)
		     (cons "PlotHidden" :vlax-false)
		     (cons "PlotViewportBorders" :vlax-false)
		     (cons "PlotViewportsFirst" :vlax-false)
		     (cons "PlotWithLineweights" :vlax-true)
		     (cons "UseStandardScale" :vlax-true)
		     (cons "StandardScale" acVpScaleToFit)
		   ) ;_ end of list
	   ) ;_ end of mapcar
	   (if (member "monochrome.ctb"
		       (vl-sort
			 (vl-remove-if
			   (function (lambda (a) (wcmatch a "*.stb")))
			   (vlax-safearray->list
			     (vlax-variant-value
			       (vla-GetPlotStyleTableNames lay)
			     ) ;_ end of vlax-variant-value
			   ) ;_ end of vlax-safearray->list
			 ) ;_ end of vl-remove-if
			 (function <)
		       ) ;_ end of vl-sort
	       ) ;_ end of member
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-true) ;_ :vlax-false or :vlax-true
	       (vla-put-StyleSheet lay "monochrome.ctb")
	     ) ;_ end of progn
	     (progn
	       (vla-put-PlotWithPlotStyles lay :vlax-false)
	     ) ;_ end of progn
	   ) ;_ end of if
	   (vla-put-NumberOfCopies plot 1)
	   (foreach
		     b
		      ent
	     (setq box (MGetBoundingBox b))
	     (vla-SetWindowToPlot
	       lay
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (car box)
		 )
	       ) ;_ end of vlax-safearray-fill
	       (vlax-safearray-fill
		 (vlax-make-safearray
		   vlax-vbDouble
		   '(0 . 1)
		 ) ;_ end of vlax-make-safearray
		 ((lambda (x) (list (car x) (cadr x)))
		   (cadr box)
		 )
	       ) ;_ end of vlax-safearray-fill
	     ) ;_ end of vla-SetWindowToPlot
	     (vla-put-PlotType lay acWindow)
	     (vla-put-PlotRotation
	       lay
	       (if
		 (apply
		   (function >)
		   (cdr
		     (reverse (mapcar (function -) (cadr box) (car box)))
		   ) ;_ end of cdr
		 ) ;_ end of apply
		  ac0degrees
		  ac90degrees
	       ) ;_ end of if
	     ) ;_ end of vla-put-PlotRotation
	     (
	      (lambda (lst / var_lst cur_val_lst temp_val_lst)
		(setq var_lst	   (mapcar (function car) lst)
		      temp_val_lst (mapcar (function cdr) lst)
		      cur_val_lst  (mapcar (function getvar) var_lst)
		) ;_ end of setq
		(mapcar (function setvar) var_lst temp_val_lst)
		(vl-cmdf "_.plot" "_no" "" "" "" "_no" "_no" "_yes")
		(mapcar (function setvar) var_lst cur_val_lst)
	      ) ;_ end of lambda
	       (list (cons "cmdecho" 0))
	     )
	   ) ;_ end of foreach
	 ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
    (princ
      "\nРабота программы невозможна - текущая вкладка не содержит объектов!"
    ) ;_ end of princ
  ) ;_ end of if
  (princ)
) ;_ end of defun

Вопрос от чайника: Как изменить масштаб печати? По умолчанию в лиспе стоит "вписать", а мне нужно чтобы можно было установить другой масштаб. Как это сделать? Где и что поменять в лиспе?

Do$ · 06.05.2010, 10:40

Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:

Код:

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

(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)

на что-то другое.
Кстати, раз уж тему подняли...
У программы обнаружился баг, по крайней мере у меня возникает:
Если печатать из файла, с которого еще не проводилась печать стандартными средствами, то иногда листы печатаются с серой надписью [none] по диагонали. Достаточно один раз использовать команду PLOT, после этого печатается без лишних надписей. Может кто подскажет, в чем может быть дело?

JokerrSergh · 06.05.2010, 11:25

Цитата:

Сообщение от Do$

Собсна, идея программы тогда теряется... Но если надо, то меняй строчки:

Код:

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

(cons "UseStandardScale" :vlax-true)
(cons "StandardScale" acVpScaleToFit)

на что-то другое.

на что другое? Если мне нужно чтобы 1мм = 1.02 ед. чертежа
на что мне поменять эти строчки? Это фиксированный масштаб, которым я обычно печатаю

Do$ · 06.05.2010, 12:15

Цитата:

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

Если мне нужно чтобы 1мм = 1.02 ед. чертежа

Таких масштабов не существует. Это наподобие 1км = 3 литра. Единицы чертежа какие?
Вот блин, а ведь действительно при печати есть такие масштабы, вот ведь бред...
Тогда значит так:
Вместо

Код:

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

(cons "UseStandardScale" :vlax-true)

пишем

Код:

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

(cons "UseStandardScale" :vlax-false)

удаляем или закомментируем строчку:

Код:

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

(cons "StandardScale" acVpScaleToFit)

, и после этой конструкции:

Код:

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

(mapcar '(lambda (a) (vlax-put-property lay (car a) (cdr a)))
           (list
             (cons "PlotType" acDisplay)
             (cons "CenterPlot" :vlax-true)
             (cons "PaperUnits" acMillimeters)
             (cons "PlotHidden" :vlax-false)
             (cons "PlotViewportBorders" :vlax-false)
             (cons "PlotViewportsFirst" :vlax-false)
             (cons "PlotWithLineweights" :vlax-true)
             (cons "UseStandardScale" :vlax-true)
             (cons "StandardScale" acVpScaleToFit)
           ) ;_ end of list
       ) ;_ end of mapcar

Добавляем строчку:

Код:

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

(vla-SetCustomScale lay 1 1.02)

Сохраняем изменения, и пробуем

JokerrSergh · 07.05.2010, 05:49

DO$
вот теперь то, что нужно, всё работает

пока багов не замечал, даже при первом распечатывании твоим лиспом всё ништятски печатается.
Спасибо огромное!!!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Опять про печать из модели нескольких листов	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

21.10.2009, 12:41
Печать из модели по выбору объекта zenon Остекляем!!! Алюминим!!! Москва Регистрация: 21.02.2005 Сообщений: 3,826 Просьба не отсылать в поиск, ибо прошерстил, но не то. Что хотелось бы, выбираешь объект, а программа сама определяет габариты границы объекта и отправляет на печать все что попадает в габариты. Настройку предлагаю производить либо при первичной загрузке программы, либо предварительно настроить стиль печати. ps см. в приложении что и как. исходник.dwg __________________ Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
Просмотров: 73836