add "change the hatch background color to none" to the attached lisp

[mruPRQUJ]

Hi, 

could you please add the below request to the attached lisp?

"change the hatch background color to none", please see the image below. Thank you very much in advance.

the below is the lisp,

(defun c:decolor_m_text_leader_dim (/ m_list m_string coloring_found color_pos)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension")))))))
(foreach m_ename m_list
(if (null (setq m_string (cdr (assoc 1 (entget m_ename)))))
(setq m_string (cdr (assoc 304 (entget m_ename))))
)
(setq coloring_found nil)
(while (or
(setq color_pos (vl-string-search "\c" m_string))
(setq color_pos (vl-string-search "\C" m_string))
)
(setq m_string (strcat (substr m_string 1 (1- color_pos))
(substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
)
coloring_found (if (null coloring_found) t coloring_found)
)
)
(if coloring_found
(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring)
(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
)
)
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ)
)

[Moshe-A]

@mruPRQUJ ,

why put it inside un relevant lisp when you can have dedicated one 😀

enjoy

Moshe

(defun c:nonBGColor (/ ss)
 (if (setq ss (ssget '((0 . "hatch"))))
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) 
   (command "._hatchedit" ename "_Color" "." ".")
  ); foreach
 ); if

 (princ)
)

[mruPRQUJ]

Thank you very much for your quick response. Is it possible to put them together? There are lots of drawings, I need to run two lisps two times if they are separate, thanks again. 

[Moshe-A]

create a tool button (Ribbon\ToolsPalette) and run them in row.

[ronjonp]

---

@mruPRQUJ wrote:

Thank you very much for your quick response. Is it possible to put them together? There are lots of drawings, I need to run two lisps two times if they are separate, thanks again. 

---

Simply put this within your existing code after the (defun c:decolor_m_text_leader_dim (/ m_list m_string coloring_found color_pos) line.

;; This loads the code
(defun c:nonbgcolor (/ ss)
  (if (setq ss (ssget "_X" '((0 . "hatch"))))
    (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (command "._hatchedit" ename "_Color" "." ".")
    )					; foreach
  )					; if
  (princ)
)
;; This runs it 
(c:nonbgcolor)

[mruPRQUJ]

Is it possible to run both of them at one time? many thanks.

[ronjonp]

---

@mruPRQUJ wrote:

Is it possible to run both of them at one time? many thanks.

---

If you do as I mentioned above yes.

[mruPRQUJ]

Could you please check if it is correct? thank you very much from the bottom of my heart.

(defun c:decolor_m_text_leader_dim (/ m_list m_string coloring_found color_pos)

;; This loads the code
(defun c:nonbgcolor (/ ss)
  (if (setq ss (ssget "_X" '((0 . "hatch"))))
    (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (command "._hatchedit" ename "_Color" "." ".")
    )					; foreach
  )					; if
  (princ)
)
;; This runs it 
(c:nonbgcolor)

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension")))))))
(foreach m_ename m_list
(if (null (setq m_string (cdr (assoc 1 (entget m_ename)))))
(setq m_string (cdr (assoc 304 (entget m_ename))))
)
(setq coloring_found nil)
(while (or
(setq color_pos (vl-string-search "\c" m_string))
(setq color_pos (vl-string-search "\C" m_string))
)
(setq m_string (strcat (substr m_string 1 (1- color_pos))
(substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
)
coloring_found (if (null coloring_found) t coloring_found)
)
)
(if coloring_found
(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring)
(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
)
)
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ)
)

[mruPRQUJ]

Hi, I need to run Lisp twice, the hatch color changed. But the first part did not work, thanks a lot!

[komondormrex · Accepted solution]

hey,

here you go.

(defun c:decolor_m_text_leader_dim_hatch (/ m_list m_string coloring_found color_pos none_background_color_object)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq m_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:l" '((0 . "mtext,multileader,dimension,hatch")))))))
	(foreach m_ename m_list 
		(cond 
			(
				(= "HATCH" (cdr (assoc 0 (entget m_ename))))
					(if (null none_background_color_object)
						(progn
							(setvar 'cmdecho 0)
							(command "_-hatchedit" m_ename "_co" "." ".")
							(setq none_background_color_object (vla-get-backgroundcolor (vlax-ename->vla-object m_ename)))
							(setvar 'cmdecho 1)
						)
						(vla-put-backgroundcolor (vlax-ename->vla-object m_ename) none_background_color_object)
					)
			)
			(
				t
					(if (null (setq m_string (cdr (assoc 1 (entget m_ename)))))
							  (setq m_string (cdr (assoc 304 (entget m_ename))))
					)
					(setq coloring_found nil)
					(while (or 
								(setq color_pos (vl-string-search "\\c" m_string))
								(setq color_pos (vl-string-search "\\C" m_string))
						   )
								(setq m_string (strcat (substr m_string 1 color_pos)
										   			   (substr m_string (+ 2 (vl-string-search ";" m_string color_pos)))
								   			   )
					      			  coloring_found (if (null coloring_found) t coloring_found) 
								)
					)
					(if coloring_found 
						(if (vlax-property-available-p (vlax-ename->vla-object m_ename) 'textstring) 
								(vla-put-textstring (vlax-ename->vla-object m_ename) m_string)
								(vla-put-textoverride (vlax-ename->vla-object m_ename) m_string)
						)
					)
			)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

[mruPRQUJ]

Thank you very much to all of you, your help is grateful and much appreciated! 🙂

[reinard5UYG2]

BAckground hatch is the thing killing x ref can this be removed?

[mruPRQUJ]

Sorry, no and thanks!