Как запретить редактирование, копирование, печать файла? (Страница 1 из 2)

;;;Функция преобразования объектов чертежа в мультивставку анонимных блоков
(defun minsert-document    (/ acaddoc block-collect m-space p-space)
  (vl-load-com)
  (setq    acaddoc          (vla-get-ActiveDocument
            (vlax-get-acad-object)
              )
    block-collect (vla-get-blocks acaddoc)
    m-space          (vla-get-modelspace acaddoc)
    p-space          (vla-get-PaperSpace acaddoc)
    old-layer     (getvar "clayer")
    old-color     (getvar "cecolor")
    old-ctab      (getvar "ctab")
  )
  (mapcar 'setvar
      '("clayer" "cecolor" "celtype")
      '("0" "BYLAYER" "BYLAYER")
  )
  (vla-startundomark acaddoc)
  (vla-purgeall acaddoc)
  (xref-bind)
  (block-unnamed)
  (foreach b (cons "Model" (layoutlist))
    (setvar "ctab" b)
    (attribute-text)
    (minsert-block)
  )
  (vla-endundomark acaddoc)
  (mapcar 'setvar
      '("clayer" "cecolor" "ctab")
      (list old-layer old-color old-ctab)
  )
  (princ)
)
;;; Функция преобразования внешних ссылок в блоки.
(defun xref-bind (/ xrefname)
  (vlax-for item block-collect
    (if
      (equal (vla-get-IsXRef item) :vlax-true)
       (setq xrefname (cons (vla-get-name item) xrefname))
    )
  )
  (if xrefname
    (progn
      (foreach i xrefname
    (vla-bind (vla-item block-collect i) :vlax-false)
      )
    )
  )
  (vla-update (vlax-get-acad-object))
  (princ)
)
;Функция преобразования описания аттрибутов в однострочный текст
(defun attribute-text (/ attrib act-sp attrib-txt)
  (if
    (setq
      attrib (ssget "x"
            (list '(0 . "ATTDEF") (cons 410 (getvar "ctab")))
         )
    )
     (progn
       (setq attrib (mapcar 'vlax-ename->vla-object
                (vl-remove-if
                  'listp
                  (mapcar 'cadr
                      (ssnamex attrib)
                  )
                )
            )
       )
       (foreach    j attrib
     (if
       (zerop (vla-get-activespace acaddoc))
        (setq act-sp p-space)
        (setq act-sp m-space)
     )
     (setq attrib-txt
        (vla-addtext
          act-sp
          (vla-get-tagstring j)
          (vlax-3d-point
            (vlax-safearray->list
              (vlax-variant-value
            (vla-get-insertionpoint j)
              )
            )
          )
          (vla-get-Height j)
        )
     )
     (vla-put-color attrib-txt (vla-get-color j))
     (vla-put-layer attrib-txt (vla-get-layer j))
     (vla-put-rotation attrib-txt (vla-get-rotation j))
     (vla-put-stylename attrib-txt (vla-get-stylename j))
       )
     )
  )
  (mapcar 'vla-delete attrib)
)
;Функция преобразования блоков в анонимные блоки
(defun block-unnamed ()
  (vlax-for item3 block-collect
    (if
      (and
    (/= (vl-string-elt (vla-get-name item3) 0) 42)
    (not (wcmatch (vla-get-name item3) "AVE*"))
      )
       (vla-put-name item3 "*U")
    )
  )
  (vla-regen acaddoc acAllViewports)
)
;Функция создания единого анонимного блока из всех объектов чертежа и
;и создание его мультивставки со смещением 0.
(defun minsert-block
       (/ nabor-total kp kp-name dxf340 nt masvar total-block)
  (if
    (setq nabor-total
       (ssget "x"
          (list
            '(-4 . "<AND")
            (cons 410 (getvar "ctab"))
            '(-4 . "<NOT")
            '(0 . "VIEWPORT")
            '(-4 . "NOT>")
            '(-4 . "AND>")
          )
       )
    )
     (progn
                    ;удаление из набора объектов являющихся контуром подрезки
                    ;видовых экранов
       (if
     (setq kp
        (ssget "x"
               (list '(0 . "viewport") (cons 410 (getvar "ctab")))
        )
     )
      (progn
        (setq kp-name (mapcar 'cadr (ssnamex kp)))
        (foreach w kp-name
          (if
        (setq dxf340 (assoc 340 (entget w)))
         (progn
           (ssdel (cdr dxf340) nabor-total)
         )            ;progn
          )                ;if
        )                ;foreach
      )                ;progn
       )                ;if
       (setq nt    (mapcar    'vlax-ename->vla-object
            (mapcar 'cadr (ssnamex nabor-total))
        )
       )
       (setq masvar (vlax-make-safearray
              vlax-vbobject
              (cons 0 (1- (length nt)))
            )
       )
       (vlax-safearray-fill masvar nt)
       (setq total-block
          (vla-add block-collect
               (vlax-3d-point '(0 0 0))
               "*U"
          )
       )
       (vla-CopyObjects acaddoc masvar total-block)
       (mapcar 'vla-delete nt)
       (if
     (zerop (vla-get-activespace acaddoc))
      (setq act-sp p-space)
      (setq act-sp m-space)
       )
       (vla-AddMInsertBlock
     act-sp
     (vlax-3d-point '(0 0 0))
     (vla-get-name total-block)
     1
     1
     1
     0
     2
     1
     0
     0
       )
     )                    ;progn
  )                    ;if
  (vla-regen acaddoc acAllViewports)
)

(defun minsert-document2 (/ acaddoc block-collect m-space p-space)
  (vl-load-com)
  (setq    acaddoc          (vla-get-ActiveDocument
            (vlax-get-acad-object)
              )
    block-collect (vla-get-blocks acaddoc)
    m-space          (vla-get-modelspace acaddoc)
    p-space          (vla-get-PaperSpace acaddoc)
    old-layer     (getvar "clayer")
    old-color     (getvar "cecolor")
    old-ctab      (getvar "ctab")
  )
  (mapcar 'setvar
      '("clayer" "cecolor" "celtype")
      '("0" "BYLAYER" "BYLAYER")
  )
  (vla-startundomark acaddoc)
  (xref-bind2)
  (block-unnamed2)
  (vla-purgeall acaddoc)
  (vlax-for item4 (vla-get-layouts acaddoc)
    (vla-put-activelayout acaddoc item4)
    (attribute-text2)
    (minsert-block2)
  )
  (vla-endundomark acaddoc)
  (mapcar 'setvar
      '("clayer" "cecolor" "ctab")
      (list old-layer old-color old-ctab)
  )
  (princ)
)
(defun xref-bind2 (/ xrefname)
  (vlax-for item block-collect
    (if
      (equal (vla-get-IsXRef item) :vlax-true)
       (setq xrefname (cons (vla-get-name item) xrefname))
    )
  )
  (if xrefname
    (progn
      (foreach i xrefname
    (vla-bind (vla-item block-collect i) :vlax-false)
      )
    )
  )
  (vla-update (vlax-get-acad-object))
  (princ)
)
(defun attribute-text2 (/ attrib act-sp attrib-txt)
  (if
    (setq
      attrib (ssget "x"
            (list '(0 . "ATTDEF") (cons 410 (getvar "ctab")))
         )
    )
     (progn
       (setq attrib (mapcar 'vlax-ename->vla-object
                (vl-remove-if
                  'listp
                  (mapcar 'cadr
                      (ssnamex attrib)
                  )
                )
            )
       )
       (foreach    j attrib
     (if
       (zerop (vla-get-activespace acaddoc))
        (setq act-sp p-space)
        (setq act-sp m-space)
     )
     (setq attrib-txt
        (vla-addtext
          act-sp
          (vla-get-tagstring j)
          (vlax-3d-point
            (vlax-safearray->list
              (vlax-variant-value
            (vla-get-insertionpoint j)
              )
            )
          )
          (vla-get-Height j)
        )
     )
     (vla-put-color attrib-txt (vla-get-color j))
     (vla-put-layer attrib-txt (vla-get-layer j))
     (vla-put-rotation attrib-txt (vla-get-rotation j))
     (vla-put-stylename attrib-txt (vla-get-stylename j))
       )
     )
  )
  (mapcar 'vla-delete attrib)
)
                    
(defun block-unnamed2 ()
  (vlax-for item5 block-collect
    (if
      (and
    (/= (vl-string-elt (vla-get-name item5) 0) 42)
    (not (wcmatch (vla-get-name item5) "AVE*"))
      )
       (vla-put-name item5 "*U")
    )
  )
  (vla-regen acaddoc acAllViewports)
)
                    (defun minsert-block2
       (/ nabor-total kp kp-name dxf340 nt masvar total-block)
  (if
    (setq nabor-total
       (ssget "x"
          (list
            '(-4 . "<AND")
            (cons 410 (getvar "ctab"))
            '(-4 . "<NOT")
            '(0 . "VIEWPORT")
            '(-4 . "NOT>")
            '(-4 . "AND>")
          )
       )
    )
     (progn
                    
       (if
     (setq kp
        (ssget "x"
               (list '(0 . "viewport") (cons 410 (getvar "ctab")))
        )
     )
      (progn
        (setq kp-name (mapcar 'cadr (ssnamex kp)))
        (foreach w kp-name
          (if
        (setq dxf340 (assoc 340 (entget w)))
         (progn
           (ssdel (cdr dxf340) nabor-total)
         )            ;progn
          )                ;if
        )                ;foreach
      )                ;progn
       )                ;if
       (setq nt    (mapcar    'vlax-ename->vla-object
            (mapcar 'cadr (ssnamex nabor-total))
        )
       )
       (setq masvar (vlax-make-safearray
              vlax-vbobject
              (cons 0 (1- (length nt)))
            )
       )
       (vlax-safearray-fill masvar nt)
       (setq total-block
          (vla-add block-collect
               (vlax-3d-point '(0 0 0))
               "*U"
          )
       )
       (vla-CopyObjects acaddoc masvar total-block)
       (mapcar 'vla-delete nt)
       (entmake    (list (cons 0 "INSERT")
              (cons 100 "AcDbMInsertBlock")
              (cons 2 (vla-get-name total-block))
              '(8 . "0")
              (cons 62 256)
              '(10 0 0 0)
              (cons 70 2)
              (cons 71 1)
              (cons 44 0.0)
              (cons 45 0.0)
        )            ; list
       )                ; entmake
     )                    ;progn
  )                    ;if
  (vla-regen acaddoc acAllViewports)
)