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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > защита чертежа

защита чертежа

Ответ
Поиск в этой теме
Непрочитано 25.11.2004, 12:39 #1
защита чертежа
Ден
 
Сообщений: n/a

Подскажите пожалуйста как дать программе обратный ход

(defun c:esconvert (/ acaddoc blocks oldvar layers lay-freeze lay-lock)
(vl-load-com)
(setq acaddoc (vla-get-activedocument (vlax-get-acad-object))
blocks (vla-get-blocks acaddoc)
;;; +7
oldvar (list (getvar "celtype"))
oldvar (cons (getvar "cmdecho") oldvar)
oldvar (cons (getvar "cecolor") oldvar)
oldvar (cons (getvar "clayer") oldvar)
layers (vla-get-layers acaddoc)
) ;_ end of setq
(xref-bind2 blocks)
;;; +14
(proxy-explod acaddoc)
;;; -14
(block-unnamed2 blocks)
(vlax-for l layers
(if (= (vla-get-freeze l) :vlax-true)
(progn
(vla-put-freeze l :vlax-false)
(setq lay-freeze (cons l lay-freeze))
) ;_ end of progn
) ;_ end of if
(if (= (vla-get-lock l) :vlax-true)
(progn
(vla-put-lock l :vlax-false)
(setq lay-lock (cons l lay-lock))
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
;;; -7
(mapcar (function setvar) '("clayer" "cecolor" "cmdecho" "celtype") '("0" "BYLAYER" 0 "BYLAYER"))
(vla-purgeall acaddoc)
;;; +1
(attribute-text2 acaddoc)
(vlax-for item4 (vla-get-layouts acaddoc)
(pl:unnblock-from-vlacol acaddoc (vla-get-block item4))
) ;_ end of vlax-for
(vla-purgeall acaddoc)
;;; -1
;;; +8
(if (vl-catch-all-error-p (vl-catch-all-apply (function vla-item) (list layers (car oldvar))))
(setq oldvar (cons "0" (cdr oldvar))
;;; +9
lay-freeze (vl-remove (vla-item layers "0") lay-freeze)
;;; -9
) ;_ end of setq
) ;_ end of if
(mapcar (function setvar) '("clayer" "cecolor" "cmdecho" "celtype") oldvar)
(foreach l lay-freeze
(if (vlax-write-enabled-p l)
(vla-put-freeze l :vlax-true)
) ;_ end of if
) ;_ end of foreach
(foreach l lay-lock
(if (vlax-write-enabled-p l)
(vla-put-lock l :vlax-true)
) ;_ end of if
) ;_ end of foreach
;;; -8
(vla-regen acaddoc acallviewports)
(princ)
) ;_ end of defun

(defun xref-bind2 (blocks / xreflist)
(vlax-for item blocks
(if (= (vla-get-isxref item) :vlax-true)
(setq xreflist (cons item xreflist))
) ;_ end of if
) ;_ end of vlax-for
;;; +10
(if (< 1 (length xreflist))
(setq xreflist
(mapcar
(function vlax-ename->vla-object)
(mapcar
(function (lambda (b) (cdr (assoc -1 b))))
(vl-remove-if-not
(function
(lambda (a)
(assoc 331 a)
) ;_ end of lambda
) ;_ end of function
(mapcar (function entget) (mapcar (function vlax-vla-object->ename) xreflist))
) ;_ end of vl-remove-if-not
) ;_ end of mapcar
) ;_ end of mapcar
) ;_ end of setq
) ;_ end of if
(foreach i xreflist
(if (vl-catch-all-error-p (vl-catch-all-apply (function vla-get-xrefdatabase) (list i)))
(vla-detach i)
(vl-catch-all-apply (function vla-bind) (list i :vlax-true))
) ;_ end of if
) ;_ end of foreach
;;; -10
) ;_ end of defun

;;; +12
(defun ent-obj-select (sel enttype)
(vla-select
sel
acselectionsetall
nil
nil
(vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
(vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) (list enttype))
) ;_ end of vla-select
) ;_ end of defun
;;; -12

;;; +2
(defun attribute-text2 (doc / attrib sel)
(vla-clear (setq sel (vla-get-activeselectionset doc)))
;;; +13
(ent-obj-select sel "ATTDEF")
;;; -13
(vlax-for j sel
(plbj-attdef-to-text j)
(setq attrib (cons j attrib))
) ;_ end of foreach
(vla-clear sel)
(foreach a attrib (vla-delete a))
) ;_ end of defun
;;; -2

;;; +11
(defun proxy-explod (doc / zombie sel actl)
(vla-clear (setq sel (vla-get-activeselectionset doc)))
(ent-obj-select sel "ACAD_PROXY_ENTITY")
(vlax-for j sel
(setq zombie (cons j zombie))
) ;_ end of foreach
(setq zombie (sublist-by-prop zombie "OwnerID")
actl (vla-get-activelayout doc)
) ;_ end of setq
(foreach l zombie
(vla-put-activelayout doc (vla-get-layout (vla-objectidtoobject doc (vla-get-ownerid (car l)))))
(foreach i l
(vl-cmdf "_.explode" (vlax-vla-object->ename i))
) ;_ end of foreach
) ;_ end of foreach
(if (/= (vla-get-activelayout doc) actl)
(vla-put-activelayout doc actl)
) ;_ end of if
(vla-clear sel)
) ;_ end of defun

(defun sublist-by-prop (lst prop / val tmp)
(if lst
(progn
(setq val (vlax-get-property (car lst) prop)
tmp (vl-remove-if-not (function (lambda (x) (= (vlax-get-property x prop) val))) lst)
) ;_ end of setq
(cons tmp (sublist-by-prop (foreach y tmp (setq lst (vl-remove y lst))) prop))
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
;;; -11

(defun block-unnamed2 (blocks)
(vlax-for item5 blocks
(if (and (/= (vl-string-elt (vla-get-name item5) 0) 42)
(not (wcmatch (vla-get-name item5) "AVE*"))
) ;_ end of and
(vla-put-name item5 "*U")
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun

;;; +4
;;; Создание копии текста из метки определения атрибута объектным методом
;;; att - объект
(defun plbj-attdef-to-text (att / doc lay loc new)
(setq doc (vla-get-document att)
lay (vla-get-activelayer doc)
) ;_ end of setq
(if (= :vlax-true (vla-get-lock lay))
(progn
(vla-put-lock lay :vlax-false)
(setq lay (list lay :vlax-true)
loc t
) ;_ end of setq
) ;_ end of progn
) ;_ end of if
(setq new (vla-addtext
(vla-objectidtoobject doc (vla-get-ownerid att))
(vla-get-tagstring att)
(vla-get-insertionpoint att)
(vla-get-height att)
) ;_ end of vla-AddText
att (list att)
) ;_ end of setq
(foreach a '("alignment" "color" "linetype" "linetypescale"
"lineweight" "normal" "obliqueangle" "plotstylename"
"rotation" "scalefactor" "stylename" "textalignmentpoint"
"textgenerationflag" "thickness" "truecolor"
"upsidedown" "visible" "layer"
)
(vl-catch-all-apply
(read (strcat "vla-put-" a))
(list new (vl-catch-all-apply (read (strcat "vla-get-" a)) att))
) ;_ end of vl-catch-all-apply
) ;_ end of foreach
(if loc
(apply (function vla-put-lock) lay)
) ;_ end of if
new
) ;_ end of defun
;;; -4

;;; +5
(defun pl:unnblock-from-vlacol (doc col / new-bl vl-blks doc insp tmp del)
(setq vl-blks (vla-get-blocks doc)
insp (vlax-3d-point '(0.0 0.0 0.0))
) ;_ end of setq
(vlax-for x col
(if (= (strcase (vla-get-objectname x)) "ACDBVIEWPORT")
(setq del (cons x del))
(setq tmp (cons x tmp))
) ;_ end of if
) ;_ end of vlax-for
(foreach d del
(if (= (vla-get-clipped d) :vlax-true)
(setq tmp
(vl-remove (vlax-ename->vla-object (cdr (assoc 340 (entget (vlax-vla-object->ename d)))))
tmp
) ;_ end of vl-remove
) ;_ end of setq
) ;_ end of if
) ;_ end of foreach
(if (and tmp
(setq new-bl (vla-add vl-blks insp "*U"))
) ;_ end of and
(progn
(vla-copyobjects
doc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length tmp))))
tmp
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
new-bl
) ;_ end of vla-copyobjects
(vla-addminsertblock
(vla-objectidtoobject doc (vla-get-ownerid (car tmp)))
insp
(vla-get-name new-bl)
1.0
1.0
1.0
0.0
1
1
0
0
) ;_ end of vla-insertblock
(foreach x tmp (vla-delete x))
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
;;; -5

(princ
"\nПеред использованием команды ознакомтесь с её описанием!\nДля запуска команды введите в командной строке: esconvert"
) ;_ end of princ

(princ)
Просмотров: 4060
 
Непрочитано 26.11.2004, 04:49
#2
Лентяй


 
Сообщений: n/a


Ден,
Если посьавить аквариум на огонь, то уха, может быть, и получится. А вот если ужк поставить в холодильник, то ни фига не выйдет. Так же и с этой программой.
 
 
Непрочитано 26.11.2004, 22:10
#3


 
Сообщений: n/a


первые 25-30 строк меня вогнали в полное УНИНИЕ (лучше я пойду пить ПИВО чем объяснять).............
Р.S/ Сегоддня же пясни ца
 
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > защита чертежа