[kheylan]

При передачи съемки для генплана, нужно удалить штриховку во всех блоках, обнулить ширину полилиний в блоках. Возможно ли это сделать, не выбирая, каждый блок??? Файл съемки прилагаю.

[Yuzer]

На ум приходит только через редактор блоков: меняем в одном - меняются все. В списке блоков не так уж и много.
я бы повставлял их отдельно и отредактировал.

[VVA]

Отсюда: delete all hatch

Код:

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

(defun C:HatchDel ()(delete-all-hatch))

(defun delete-all-hatch (  / adoc *error*)
  
  (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")
            (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))
  ) ;_ end of setq
  (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 in command line")

Код:

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

(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

По поводу ширины полилиний см здесь: LISP. Нормализация блоков текущего файла пост 13

[kheylan]

VVA, спасибо большуйшее!
Меня устроил код erase-hatch, он удаляет выборочно, т.е. не удаляет на блокированых и замороженных слоях, так как кроме не нужной штриховки (в данный момент) есть нужная, типа болото и т.д.
HatchDel- сносит все

[VVA]

Сообщение от kheylan HatchDel- сносит все

Для этого я его и писал. У нас съемки - либо 500 растры, либо вектор, но там не используется штриховка, а блоки условных обозначений. А вот когда свой ГП передают другие институты, то нужно снести все не взирая на регалии. Кстати, раз ты занимаешься ГП, то возможно тебе будет интересна эта тема : Подоснова и набор программ из поста #24

[Vombat]

Здравствуйте.
Подскажите, пожалуйста, каким способом можно удалить во всех блоках ТОЛЬКО штриховку «SOLID», а остальные штриховки не трогать.
Спасибо.

P.S. Получаю чертежи от смежников экспортирование из Archicad, а там черт голову сломает.

[VVA]

Сообщение от Vombat каким способом можно удалить во всех блоках ТОЛЬКО штриховку «SOLID», а остальные штриховки не трогать.

Переделанный код из #3. Имя образца штриховки передается параметром. Можно удалять любые образцы.

Код:

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

(defun C:ESH ()
  ;;;Command EraseSolidHatch
  (erase-hatch-pattern "SOLID")
  )
(defun erase-hatch-pattern ( pat / adoc)
(vl-load-com)
  (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 (and (eq (vla-get-objectname ent) "AcDbHatch")
                 (eq (strcase(vla-get-PatternName ent))(strcase pat))
                 )
          (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)
  (vla-regen adoc acallviewports)
  (princ)
  ) ;_ end of defun

[afonin_artem]

Здравствуйте! Ни один лисп не работает, подскажите как быть?

**** Системные переменные не изменены ****
Команда: (LOAD "C:/Users/Artem.A/Desktop/ЛИСПы/ERASE.lsp") C:ERASE-HATCH

(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