Change all hatches with an area bigger then x

[sven.deleau]

Goodmorning,

I currently have the following lisp that i use for changing certain hatches.

I tried to add a extra and function for the area of an hatch but i have no idea how.

Could someone help me?

(defun c:solid2dots ( / doc )
   (vlax-for blk (vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object))))
       (if (= :vlax-false (vla-get-isxref blk))
           (vlax-for obj blk
               (if
                   (and
                       (= "AcDbHatch" (vla-get-objectname obj))
                       (= "SOLID" (strcase (vla-get-patternname obj)))
		       (= "N-CO-BC-BETONVORM-GN" (strcase (vla-get-layer obj)))
		       (> 200 (vla-get-area))
                       (vlax-write-enabled-p obj)
                   )
                   (progn
                       (vla-setpattern obj achatchpatterntypepredefined "DOTS")
                       (vla-put-patternscale obj 100.0)
                   )
               )
	       (if
                   (and
                       (= "AcDbHatch" (vla-get-objectname obj))
                       (= "SOLID" (strcase (vla-get-patternname obj)))
		       (= "N-CO-BC-BETONVORM-G" (strcase (vla-get-layer obj)))
		       (> 200 (vla-get-area))
                       (vlax-write-enabled-p obj)
                   )
                   (progn
                       (vla-setpattern obj achatchpatterntypepredefined "DOTS")
                       (vla-put-patternscale obj 100.0)
                   )
               )
           )
       )
   )
   (vla-regen doc acallviewports)
   (princ)
)
(vl-load-com) (princ)

[Kent1Cooper]

(> 200 (vla-get-area obj))

[sven.deleau]

Thanks! didn't notice that, but it doesn't work yet. i get no error whatsoever within autocad

[Kent1Cooper]

Did you fix it in both places?  [I don't see what the difference is between the two "halves" of the code.]

[sven.deleau]

Hi,

Yeah i did 🙂
The difference is 1 letter in the layer name. I tried to use an "And" in combination with "Or" but that didn't seem to work, so i wrote the function 2 times to make it work.

[pbejse]

---

@sven.deleau wrote:
Yeah i did 🙂

---

One obvious reason is the conditions are not met hence no activity

---

@sven.deleau wrote:
The difference is 1 letter in the layer name. I tried to use an "And" in combination with "Or" but that didn't seem to work, so i wrote the function 2 times to make it work.

---

(vlax-for obj blk
               (if
                   (and
                       (= "AcDbHatch" (vla-get-objectname obj))
                       (= "SOLID" (strcase (vla-get-patternname obj)))
		       (member (strcase (vla-get-layer obj))  '("N-CO-BC-BETONVORM-GN" "N-CO-BC-BETONVORM-G" ))
		       (> 200 (vla-get-area obj))
                       (vlax-write-enabled-p obj)
                   )
                   (progn
                       (vla-setpattern obj achatchpatterntypepredefined "DOTS")
                       (vla-put-patternscale obj 100.0)
                   )
               )
	       
           )

[sven.deleau]

Hi,
Thanks for the reply I tested it in multiple situations:
Without the hatch area, it does work with a single layer.
Without the hatch area, it does not work with multiple layers (member function)
With the hatch area it doesn't work in both occasions

What should i do? 

[hmsilva]

Change

(> 200 (vla-get-area obj))

to

(> (vla-get-area obj) 200)

Hope this helps,
Henrique

[sven.deleau]

Hi,

Sadly it doesn't work. also tried
(< (vla-get-area obj) 200)

Maybe because of units issue

[hmsilva]

---

@sven.deleau wrote:
Hi,

Sadly it doesn't work. also tried
(< (vla-get-area obj) 200)

Maybe because of units issue

---

Post the DWG file with some hatches 

[sven.deleau]

Hereby a little snipped of the dwg i have to process

[pbejse]

...
 Area (RO) = AutoCAD.Application: Not applicable
...

What we can do is to add a function to extract the area in another way.

[Kent1Cooper]

---

@pbejse wrote:

.... What we can do is to add a function to extract the area in another way.

---

It doesn't like the (getpropertyvalue) approach, either:
Area (type: double) (RO) (LocalName: Area) = Failed to get value

[sven.deleau]

haha, i think this is a little bit above my head... i created a lisp which filters the hatch by selection (manually) to provide the current work process. Maybe i will look into this on a later moment with a clear mind 🙂

[ВeekeeCZ]

Slow and dirty. But the only way I can think of.

(defun c:Blidedots ( / *error* sv ov s i n l a h r x)


    (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if ov (mapcar 'setvar sv ov))
    (princ))
  

  (setq sv '("clayer" "hpseparate"  "hpname"))
  (setq ov (mapcar 'getvar  sv))
  
  (setvar 'hpseparate 1)
  (setvar 'hpname "DOTS")

  (if (setq s (ssget "_:L" '((0 . "INSERT"))))
    (repeat (setq i (sslength s))
      (setq n (cdr (assoc 2 (entget (ssname s (setq i (1- i)))))))
      (if (not (vl-position n l))
	(progn
	  (setq l (cons n l))
	  (command "_.-bedit" n)
	  (foreach y '("N-CO-BC-BETONVORM-GN" "N-CO-BC-BETONVORM-G")
	    (setq e (entlast)
		  h (ssadd)
		  r (ssadd))
	    (if (setq x (ssget "_X" (list '(0 . "HATCH") (cons 8 y))))
	      (progn
		(setvar 'clayer y)
		(command "_.hatchgenerateboundary" x "")
		(while (setq e (entnext e))
		  (if (and (not (vl-catch-all-error-p (setq a (vl-catch-all-apply 'vlax-curve-getarea (list e)))))
			   (> a 200))
		    (ssadd e h))
		  (ssadd e r))
		(if (> (sslength h) 0) (command "_.-bhatch" "_s" h "" ""))
		(command "_.erase" x r "")
		(if (setq x (ssget "_X" (list '(0 . "HATCH") (cons 8 y))))
		  (command "_.draworder" x "" "_b")))))
	  (command "_.bsave")
	  (command "_.bclose")
	  (if (> (getvar 'cmdactive) 0) (command "_save"))))))
  (*error* "end")
  )

[ВeekeeCZ]

---

@pbejse wrote:

...
 Area (RO) = AutoCAD.Application: Not applicable
...

What we can do is to add a function to extract the area in another way.

---

Be interested. Don't be too modest and show off.