[Малюк]

Необходимо электронный чертёж передать заказчику. Чертёж состоит из блоков с атрибутами, в каждый блок вставлена гиперсылка. Необходим лисп на удаление всех атрибутов из блоков и гиперсылок со всех элементов в чертеже (зачем заказчику лишнее знать). Всем кто ответит спасибо.

[Кулик Алексей aka kpblc]

Попробуй сначала burst из Express Tools

[VVA]

Сообщение от Кулик Алексей aka kpblc Попробуй сначала burst из Express Tools

С учетом http://dwg.ru/f/showthread.php?t=24279
По поводу удаления гиперссылок
_-HYPERLINK _R _ALL

[Малюк]

burst - разваливает блоки а надо чтобы они были целыми

[Vova]

Если есть даже две-три сотни атрибутов то вручную их удалить можно за пол-часа. Можно и таким лиспом http://www.caduser.ru/cgi-bin/f1/board.cgi?t=21807yD заменить все атрибуты, например, на ххх или на -, или на .. Не помню, можно-ли замемить атрибуты на пробел

[VVA]

Особо не проверял

Код:

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

;;Hyperlink and Attribute Delete
(defun C:HAD ( / tempObjType *error* lst NewBlk)
    (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ))
(vl-load-com)  
(cts:layer-status-save) (princ "\n ** Start ***")
(vlax-for Blk (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)))
 (if (= (vla-get-IsXref Blk) :vlax-false)
  (vlax-for Obj Blk (setq tempObjType (vla-get-ObjectName Obj))
    (terpri)(princ tempObjType)
    (cond ((vl-position tempObjType '("AcDbAttribute" "AcDbAttributeDefinition"))
	   (vla-delete Obj))
	  ((and (vl-position tempObjType '("AcDbBlockReference"))
		(= (vla-get-HasAttributes obj) :vlax-true)
		(not (vl-position Obj lst))
		)
	   
	   (setq NewBlk (vla-InsertBlock (vla-ObjectIDToObject
	   (vla-get-activedocument (vlax-get-acad-object)) (vla-get-OwnerID Obj))
	       (vla-get-insertionpoint Obj)(vla-get-name Obj)
	       (vla-get-xscalefactor Obj)(vla-get-yscalefactor Obj)
	       (vla-get-zscalefactor Obj)(vla-get-rotation Obj)))
	   (mapcar '(lambda (x y) (vlax-put-property NewBlk x y))
	   '(Linetype LineWeight Color Layer)
	   (mapcar '(lambda (x) (vlax-get-property Obj  x))
	     '(Linetype LineWeight Color Layer)))
	   (vla-delete Obj)
	   (setq lst (cons NewBlk lst) Obj NewBlk)
	   )
	  (t nil)
	  )
    (vlax-for hyp (vla-get-hyperlinks Obj)(vla-delete hyp))
    )
   )
  )
  (cts:layer-status-restore)
  (princ "     ** End ***")(princ)
  )

(defun cts:layer-status-restore ()
    (foreach item *PD_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    (setq *PD_LAYER_LST* nil)
    ) ;_ end of defun

  (defun cts:layer-status-save ()
    (setq *PD_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *PD_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            *PD_LAYER_LST*
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
      ) ;_ end of vlax-for
    ) ;_ end of defun

[Малюк]

Спасибо всё работает!!!