[Serge_BN]

Как сделать вот так:
При нажатии на какую-то кнопочку или клавиатурное сокращение или при вызове из ком.строки запускалась бы команда рабоающая в двух режимах.
1. Режим настройки печати в котором задается (возможно используя стандартный диалог) устройство вывода на печать (DWG to PDF) какой нить *.pc3 файл или еще как-то, место куда сохранять файлы, шаблон имени файла, суффикс к этому шаблону (приращение, например, 1) , эти настройки где-то запоминаются.
2. Режим выбора области печати и отправки ее на устройство печати (в файл pdf). Здесь должно работать так:
Действия пользователя -вызов команды,запрос области печати.
Действия программы - расчет длины по горизонтали и вертикали, в соответствии с этим выбирается формат бумаги из заранее заготовленных и где-то сохраненных (возможно в *.pc3?)
формируется имя файла по следующим данным - т.к. в правом нижнем углу чертежа всегда есть основная надпись, то от-туда и считываем ШИФР + номер листа (либо взять из настроек) + окончание .pdf это и будет очередным именем файла. Ну и сама печать без дополнительных каких-либо нажатий и щелканий, каталог куда сохранять настраиваем в режиме 1. Т.о. процесс печати должен сводиться к вызову команды и заданию области печати, ну и первоначальным настройкам.
Задача возникла в связи с тем, что требуется массовый перевод проектов в формат pdf. И уж больно муторно каждый лист как в первый раз.
Заранее спасибо всем кто откликнется на данную просьбу.

[Reka]

Подшивки рулят!

[Serge_BN]

В дополнение к теме. Сейчас преобразовал два десятка чертежей в pdf и пришла мысль. Что если сначала по формату чертежа создавать какой-то блок, который автоматически себя нумерует в соответствии с шифром + приращение+ .pdf. Блок я ставлю вручную.
а потом запустить некий лисп, который выберет все эти блоки вычислит по ним области печати и отправит на печать все эти области. Каждую в свой файл. Так вообще будет замечательно.

[Nike]

эту тему полистай http://forum.dwg.ru/showthread.php?t=41621&pp=
вроде бы там эту задачу решили

[Serge_BN]

Посмотрел решения, которые приведены в указанном выше посте. Возникли проблемы.
1. Необходимо выбрать не принтер установленный в системе, а устройство печати DWG to PDF существующее только в АКАДе в виде файла с расширением pc3. Данная программа не видит это устройство и соответственно не отображает его в списке принтеров.
2. Хотелось бы увидеть в списке кроме перечня принтеров, установленных в системе, еще перечень файлов *.pc3, что бы можно было выбирать созданные ранее pc3.
3. В случае печати в файл возникает необходимость формировать имя файла. Этот процесс тоже желательно как-то автоматизировать.
Что бы не было лишних нажатий мыши.
Возможно ли так сделать?

[Profan]

Посмотри здесь:
http://www.caduser.ru/forum/index.ph...D=44&TID=27854
Только вряд ли я вернусь к этой программе, очень муторная.

[Do$]

Сообщение от Serge_BN 2. Хотелось бы увидеть в списке кроме перечня принтеров, установленных в системе, еще перечень файлов *.pc3, что бы можно было выбирать созданные ранее pc3.

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

Код:

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

(wcmatch a "*.pc3")

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

[Serge_BN]

Теперь в списке присутствуют pc3. Но
1. Я печатаю в файл, а программа не спрашивает куда сохранять этот файл и не спрашивает имени файла, но это как бы и хорошо.
Хотелось, что бы можно было задать целевой каталог для файлов один раз и чтобы можно было задать тоже один раз шаблон имени файла и запомнить его а при сохранении программа формировала бы автоматически имя файла, прибавляя к нему каждый раз единичку, например, так шаблон_имени-1.pdf следующий файл шаблон_имени-2.pdf и т.д.
2. если в одном файле dwg много чертежей, приходится каждый раз выбирать имя устройства (мой.pc3). Можно сделать так, что бы это как-то где-то запоминалось? и мой.рс3 выбирался бы по умолчанию после первого раза?
Так же это относится и к формату целевого листа., т.е. что-то типа предыдущей печати, но автоматом, что бы не было лишних щелканий мышью?

[Do$]

Сообщение от Serge_BN 1. Я печатаю в файл, а программа не спрашивает куда сохранять этот файл и не спрашивает имени файла, но это как бы и хорошо. Хотелось, что бы можно было задать целевой каталог для файлов один раз и чтобы можно было задать тоже один раз шаблон имени файла и запомнить его а при сохранении программа формировала бы автоматически имя файла, прибавляя к нему каждый раз единичку, например, так шаблон_имени-1.pdf следующий файл шаблон_имени-2.pdf и т.д.

Насколько я понимаю, при печати в pdf, AutoCAD передает изображение в стороннюю программу, а уже она сохраняет переданный рисунок в файл (По крайней мере я именно так печатаю в pdf). Управлять внешней программой из AutoCAD'а с помощью LISP - я такого не умею... Если же все это происходит внутри самого AutoCADа без помощи внешних программ - то, пожалуй, можно как-то добраться до настроек и параметров...

Сообщение от Serge_BN 2. если в одном файле dwg много чертежей, приходится каждый раз выбирать имя устройства (мой.pc3). Можно сделать так, что бы это как-то где-то запоминалось? и мой.рс3 выбирался бы по умолчанию после первого раза?

Это можно.

[Serge_BN]

Ладно, с первым что-нибудь придумаю. Хотя DWG to PDF в 2008 АКАДе у меня установилось по умолчанию как бы в составе самого АКАДа, т.е. я не устанавливал каких-то дополнительных программ для печати в pdf.
По второму. Будьте так добры, приделайте, плз, эту фишку. Уж очень много нажатий приходится делать.

[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*  (if *plot_name* *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

[Serge_BN]

Спасибо. Уже ближе к тому что надо! pc3 восстанавливает, а вот формат листа забывает, приходится опять вручную напоминать. Очень неудобно.
И еще. У меня много разных dwg файлов и в каких-то есть блоки для рамок а в других нет. Т.к. выбор области печати все-равно приходится задавать руками, то нельзя ли сделать так, что бы по умолчанию программа просто запрашивала область печати так как это делается при обычной печати. А опции Несколько|Блок пусть останутся нга случай если есть подходящие блоки.

[Do$]

Сообщение от Serge_BN а вот формат листа забывает

А я должен был мысли прочитать? Надо сразу говорить.

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

А зачем? Это все есть в стандартной утилите печати.

[Serge_BN]

Надо сразу говорить

Да, вроде где-то выше я упоминал об этом.

А зачем? Это все есть в стандартной утилите печати.

Ну да там это есть. Но там есть и множество такого от чего я хочу избавиться. И ваша программа как раз это и позволяет. Но, т.к. приходится обрабатывать множество разных файлов, сделанных разными людьми и в разных конторах, то необходима разновариантная возможность выбора области печати. Я говорю только о выборе области печати. Все остальное в стандартном диалоге печати не устраивает, потому как там приходится много делать лишнего.