Author Topic: delete all hatch  (Read 19158 times)

0 Members and 1 Guest are viewing this topic.

AUTOKAD

  • Guest
delete all hatch
« on: July 01, 2010, 12:37:30 PM »
Please help.
I need to clean up a drawing.
Most of it are in blocks and the blocks are hatched.
I need to 'globally' delete all the hatches within the blocks.
Please help

Hangman

  • Swamp Rat
  • Posts: 566
Re: delete all hatch
« Reply #1 on: July 01, 2010, 01:29:48 PM »
Are you looking for a piece of code or for someone to write a routine for you ??

If you're looking for a piece of code, there are several posts here at the swamp regarding accessing entities in blocks and modifying entities in blocks.  By searching these, that'll get you the code for getting into the blocks.
Then it's a simple process of identifying the hatch and deleting it, then moving on to the next block.

If you're looking for someone to write the code for you, good luck.  The guru's here are more than willing to help you learn to write the code, offering what they can when you are stuck, and throwing out a boatload of suggestions.  But to just write code for a fellow swamper they won't necessarily do, believe me I've tried.   :wink:
Hangman  8)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Drafting Board, Mechanical Arm, KOH-I-NOOR 0.7mm
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

VVA

  • Newt
  • Posts: 166
Re: delete all hatch Add Hatch2lay command
« Reply #2 on: July 01, 2010, 01:31:27 PM »
Try it
Code: [Select]
(vl-load-com)
(defun C:HatchDel ()(work-whith-all-hatch nil))
(defun C:Hatch2Lay ()
  ;;; Hatch to Layer
  ;;; http://www.cadtutor.net/forum/showthread.php?87471-Move-Hatching-to-specified-layer
  ;;; http://www.theswamp.org/index.php?topic=33975.0
  (work-whith-all-hatch
    "NewLayerForHatch"   ;_  type  layer name for hatch
    )
  (alert "Done!")(princ)
  )
(defun work-whith-all-hatch ( what  / adoc *error*)
  ;;; what - nil - delete
  ;;;      - string - layer to move
  (defun *error* (msg)
    (setvar "MODEMACRO" "")
    (princ msg)
    (vla-regen aDOC acactiveviewport)
    (bg:progress-clear)
    (bg:layer-status-restore)
    (princ)
  ) ;_ end of defun
  (defun _loc-delete-items ()
    (if (= (vla-get-IsXref Blk) :vlax-false)
      (progn
(setq count 0)
(if (> (vla-get-count Blk) 100)
  (bg:progress-init
    (strcat (vla-get-name Blk) " :")
    (vla-get-count Blk)
  ) ;_ end of bg:progress-init
  (progn
    (setvar "MODEMACRO" (vla-get-name Blk))
  ) ;_ end of progn
) ;_ end of if
(vlax-for Obj Blk
  (if (= (vla-get-ObjectName Obj) "AcDbHatch")
            (if (and what (eq (type what) 'STR))
              (vl-catch-all-apply 'vla-put-Layer (list Obj what))
              (vl-catch-all-apply 'vla-delete (list Obj))
              )
  ) ;_ end of if
) ;_ end of vlax-for
(bg:progress-clear)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
  (setq aDOC (vla-get-activedocument (vlax-get-acad-object)))
  (if (and (eq (type what) 'STR)
           (not(tblobjname "LAYER" what))
           )
    (vla-add (vla-get-Layers aDOC) what)
    )
  (bg:layer-status-save)
  (vlax-for Blk (vla-get-Blocks aDOC)
(_loc-delete-items)
    )
  (bg:layer-status-restore)
    (vla-regen aDOC acActiveViewport)
  (princ)
) ;_ end of defun
(defun bg:layer-status-restore ()
    (foreach item *BG_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 *BG_LAYER_LST* nil)
    ) ;_ end of defun

  (defun bg:layer-status-save ()
    (setq *BG_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *BG_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            *BG_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
(defun bg:progress-init (msg maxlen)
  ;;; msg - сообщение или пустая строка
  ;;; maxlen - максимальное количество
  (setq *BG:PROGRESS:OM* (getvar "MODEMACRO"))
  (setq *BG:PROGRESS:MSG* (vl-princ-to-string msg))
  (setq *BG:PROGRESS:MAXLEN* maxlen)
  (setq *BG:PROGRESS:LPS* '-1)(princ)
  )
(defun bg:progress ( currvalue / persent str1 count)
  (if *BG:PROGRESS:MAXLEN*
    (progn
  (setq persent (fix (/ currvalue 0.01 *BG:PROGRESS:MAXLEN*)))
  ;;;Каждые 5 %
  (setq count (fix(* persent 0.2)))
  (setq str1 "")
  (if (/= count *BG:PROGRESS:LPS*)
    (progn
      ;;(setq str1 "")
      (repeat persent (setq str1 (strcat str1 "|")))
      )
    )
       ;;; currvalue - текущее значение
      (setvar "MODEMACRO"
              (strcat (vl-princ-to-string *BG:PROGRESS:MSG*)
                      " "
                      (itoa persent)
                      " % "
                      str1
                      )
              )
      (setq *BG:PROGRESS:LPS* persent)
  )
    )
  )
     
(defun bg:progress-clear ()
  (setq *BG:PROGRESS:MSG* nil)
  (setq *BG:PROGRESS:MAXLEN* nil)
  (setq *BG:PROGRESS:LPS* nil)
  (setvar "MODEMACRO" (vl-princ-to-string *BG:PROGRESS:OM*))
  ;;;(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
  (princ)
  )
(princ "\nType HatchDel or Hatch2Lay in command line")(princ)
« Last Edit: July 02, 2014, 09:29:45 AM by VVA »

kpblc

  • Bull Frog
  • Posts: 396
Re: delete all hatch
« Reply #3 on: July 01, 2010, 01:33:22 PM »
Try this:
Code: [Select]
(vl-load-com)

(defun c:erase-hatch (/ adoc)

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (equal (vla-get-isxref blk_def) :vlax-false)
      (vlax-for ent blk_def
        (if (= (vla-get-objectname ent) "AcDbHatch")
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-erase ent)
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of if
        ) ;_ end of vlax-for
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
Hatches on locked / frozen layers won't erase.
Sorry for my English.

AUTOKAD

  • Guest
Re: delete all hatch
« Reply #4 on: July 01, 2010, 01:41:49 PM »
thank you all!

Hangman

  • Swamp Rat
  • Posts: 566
Re: delete all hatch
« Reply #5 on: July 01, 2010, 01:42:30 PM »
If you're looking for someone to write the code for you, good luck.  ...

Well, I stand corrected.  Where were you guys when I was first learning ??

Oh well, I know much more now than I did then.
Hangman  8)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Drafting Board, Mechanical Arm, KOH-I-NOOR 0.7mm
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

alanjt

  • Needs a day job
  • Posts: 5352
  • Standby for witty remark...
Re: delete all hatch
« Reply #6 on: July 01, 2010, 03:15:00 PM »
If you're looking for someone to write the code for you, good luck.  ...

Well, I stand corrected.  Where were you guys when I was first learning ??

Oh well, I know much more now than I did then.
Depends on the mood.  :lol:
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Tharwat

  • Swamp Rat
  • Posts: 707
  • Hypersensitive
Re: delete all hatch
« Reply #7 on: July 05, 2010, 01:17:56 PM »
If you're looking for someone to write the code for you, good luck.  ...
Well, I stand corrected.  Where were you guys when I was first learning ??
Oh well, I know much more now than I did then.
I gree with you, But in business and in this world nowadays, you have to give the nine to get the ten......................

Tharwat