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

zenon · 21.10.2009, 12:41

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

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

исходник.dwg

Колька · 13.11.2009, 22:04

Цитата:

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

Колька, мне вот что интересно: а если твой блок "Ramka_dlya_pechati" стоит в нескольких листах чертежа, как будет происходить печать тех блоков, которые находятся не на текущем листе?

хреново

я об этом думал, тока пока не было повода дописать. у меня был код выделяющий все блоки с определённым именем на чертеже, можно её приделать сюда, потом, если понадобится.

Получилось хоть у кого нить прогу то запустить?

JokerrSergh · 16.11.2009, 07:09

Колька, получилось запустить, все работает и печатает

Теперь вопросы:
1. После запуска проги нужно каждый раз устанавливать принтер и бумагу? Или можно сделать чтобы при первом запуске проги выбрал принтер, а при остальных запусках он уже был установлен.
2. Хотелось бы иметь возможность менять масштаб печати, ибо "вписать" не всегда устраивает.
В остальном меня все устраивает

СПАСИБО разработчику и всем участникам

Колька · 16.11.2009, 07:35

Всю автоматичность можно задать в строчке (command "_plot"...
например если хочешь что бы был принтер XEROX WORKCENTRE PRO 133 PCL 6 и масштаб 1:100 пишешь так:

Код:

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

(command "_plot" "_y" "" "XEROX WORKCENTRE PRO 133 PCL 6" paper "_Millimeters" text "_No" "_Window" p1 p2  "1:100" "_center" "_Yes" "monochrome.ctb" "_Yes" "_As" "_N" "_N" "_Y")

и не забудь если сделал фиксированный принтер удалить строчки

Код:

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

	(setq l_pr (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))))  
	(setq printer (dialog_n l_pr))

можешь этот код на разные команды сделать и разные кнопочки присвоить

JokerrSergh · 16.11.2009, 07:48

Благодарствую, все стало именно так, как мне нужно

И еще вопрос:
Я так понял, что за один запуск проги, можно напечатать листы только одного формата.
Можно ли как-нибудь одновременно (при одном запуске проги) печатать несколько форматов листов (например А3 и А4)?
Т.е. запускаешь прогу и выделяешь лист формата А3 и лист формата А4, и прога печатает лист А3 и лист А4.

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

JokerrSergh · 18.11.2009, 04:35

и тишина

Колька · 18.11.2009, 08:31

пардон, у меня что то оповещение не дошло.

Цитата:

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

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

Я над этим думал, но проблема в том что листы не всегда в одном масштабе рисуют, в следствии чего по размеру лист не опознать, по пропорциям тоже не катит(они все одинаковые) единственное что приходит в голову сделать у моего блока атрибут и по нему проверять, что за лист. Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

JokerrSergh · 18.11.2009, 09:15

Цитата:

Сообщение от Колька

пардон, у меня что то оповещение не дошло.

Я над этим думал, но проблема в том что листы не всегда в одном масштабе рисуют, в следствии чего по размеру лист не опознать, по пропорциям тоже не катит(они все одинаковые) единственное что приходит в голову сделать у моего блока атрибут и по нему проверять, что за лист. Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

Я бы сделал так (если бы умел программировать):
1)В твой блок с точками запихать атрибут, отражающий масштаб листа. По умолчанию задать масштаб 1, или 1:1 (зависит от формы отображения масштаба). Если какой-нибудь лист нарисован в отличном от 1:1 масштабе, то во время расстановки этих блоков юзер изменяет значение атрибута на нужный масштаб.
2)После ввода в ком. строку NPr прога должна взять Х distance и Y distance из твоего блока с точками и сравнить их значения с некой базой, в которой заложены размеры листов (с учетом масштаба). Результатом сравнения должен быть формат листа, который подается на принтер.

LSN · 18.11.2009, 09:20

Попробывал твою прогу. Все нормально запустилось. Но действительно было бы удобно, если бы она сама распознавала формат листа.

Цитата:

Сообщение от Колька

Короче надо думать чем жертвовать временем при распечатке или при расстановке блоков.

Лучше пожертвовать временем при расстановке блоков, т.к. их все равно нужно расставлять, а изменить атрибут можно сразу нескольким блокам.

Есть ли возможность определять формат по названию параметра видимости динамического блока? И возможно ли тогда будет в блок вставить рамку, или здесь и возникают ошибки о которых ты писал?

Колька · 18.11.2009, 09:36

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

Скорей всего придёться при самом первом запуске проги говорить ей какой формат с каким соотносится и в текстовый файлик это записать. Буду думать как это сделать.

Do$ · 18.11.2009, 11:00

Как альтернативу, выложу бета-версию программы, в которой я попытался по максимуму уйти от коммандных методов.
Печатает варианты:

выбранный объект
несколько выбранных объектов
все блоки с определенным именем на чертеже

Бета-версия, потому что есть мысли по усовершенствованию (если будет время и желание

)
У программы есть особенности:

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

Код:

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

(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 min_point max_point)
      (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 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-variant-value
			     ) ;_ 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-variant-value
			     ) ;_ 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

    (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

Колька · 18.11.2009, 11:37

Do$, професионально

я и не подумал о том что можно .dcl автоматически создавать и отсортировывать форматы A... вобчем пошёл я совершенствоваться

Do$ · 18.11.2009, 11:57

Цитата:

Сообщение от Колька

я и не подумал о том что можно .dcl автоматически создавать

Тоже об этом не помышлял, пока не заметил в pltools у VVA

Кулик Алексей aka kpblc · 18.11.2009, 13:28

Цитата:

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

и тишина

http://forum.dwg.ru/showthread.php?t=30619

zenon · Регистрация: 21.02.2005

Поскольку предыдущая тема Печать из модели по выбору объекта, по вине несознательных товарищей была закрыта, а суть вопроса до конца не раскрыта, создаю новую тему.
Итак, с темой вопроса прошу ознакомится в приведенной выше ссылке, сегодня имеем программку товарища 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 min_point max_point)
      (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 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-variant-value
			     ) ;_ 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-variant-value
			     ) ;_ 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

    (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

Но лисп работает некорректно.
Печатает четвертями, а то и восьмушками, причем только правый нижний угол.

Кулик Алексей aka kpblc · 23.11.2009, 11:29

Тема открыта. Прошу прощения, что сразу не сделал.

Do$ · 23.11.2009, 12:32

Цитата:

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

Печатает четвертями, а то и восьмушками, причем только правый нижний угол.

Хоть один пример бы. (dwg, в формате acad2004)

zenon · 23.11.2009, 12:49

Цитата:

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

Хоть один пример бы. (dwg, в формате acad2004)

например вот
сам файл
Пример.dwg
выбор по блоку

Нажмите на изображение для увеличения
Название: Vibor_pechat.JPG
Просмотров: 179
Размер: 18.3 Кб
ID: 29429

и собсно результат
Результат.pdf

Do$ · 23.11.2009, 12:58

Это то, о чем писал Алексей:

Цитата:

Сообщение от Кулик Алексей aka kpblc

Из обработки напрочь исключаются атрибуты; не учитывается поворот и немировая система координат; не рассматривается вопрос масштаба, не равного 1.0 хотя бы по одному из направлений.

В приложенном чертеже блоки растянуты, а печатает, как будто масштаб блока 1:1.

zenon · 23.11.2009, 13:41

Do$, то-исть это не лечится??
ps эх а шастье было так близко

Do$ · 23.11.2009, 14:06

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

Код:

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

(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

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

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