Jump to content

Convert hatch to arc/lines

Marc_AM

By Marc_AM
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Marc_AM Newbie

Marc_AM

Posted
Posted

Hello everyone, my first post here.

I'm trying to do the following tasks:

 

1) explode blocks one by one

2) keep only hatch

3) generate hatch boundary (lwpolylines) one by one

4) explode the above lwpolyline into arcs and lines

5) overwrite the starting blocks with new blocks created by above arcs and lines (same name and position of the starting blocks) - - - > not implemeted yet: work in progress

6) erase all the other blocks

 

My code is doing the job but it stops every cycle and I have to press ENTER a lot of times to finish the job.

I suppose it's very easy to fix but I'm a beginner and I need some help.

 

In attachment a sample of dxf file I am working at.

 

p.s. sorry but english is not my native language.

  

(defun readinsert ()
   (setq w (ssname ss1 n))
   (setq a (entget w))
   (explodeinsert)
   (keephatch)
   (setq n (1- n))
)
(defun explodeinsert ()
   (ssadd w ss2)
   (command "._explode" ss2 "")
   (ssdel w ss2)	
)
(defun keephatch ()	
   (setq ultimi (entlast))
   (setq a4 (entget ultimi))
   (ssadd ultimi ss3)
   (command "._HATCHGENERATEBOUNDARY" ss3 "")
   (ssdel ultimi ss3)
   	(explodelwpoly)
)
(defun explodelwpoly ()
   (setq ss4 (ssget "_p"))
   (command "._explode" ss4 "")
   (setq ss (ssget "_p"))
)

(defun c:hatch2arclines ()
   (command "._zoom" "e")
   (command "._zoom" "0.97x")
   (setq qaf (getvar "QAFLAGS"))
   (setvar "QAFLAGS" 1)
   (setq ss1 (ssget "X" '((0 . "INSERT"))))
   (setq ss2 (ssadd))
   (setq ss3 (ssadd))
   (setq n (1- (sslength ss1)))
   (while (>= n 0) (readinsert))
   	(setq regioni1 (ssget "X" '((0 . "REGION"))))
	(command "._erase" regioni1 "")
	(setq regioni2 (ssget "X" '((0 . "HATCH"))))
	(command "._erase" regioni2 "")
	(setq regioni23 (ssget "X" '((0 . "INSERT"))))
	(command "._erase" regioni23 "")
	(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
   (setvar "QAFLAGS" qaf)
)

 

Disegno1-I.dxfFetching info...

BIGAL Grand Master

BIGAL

Posted
Posted

Just a comment, there is no check for does this return nil (setq regioni1 (ssget "X" '((0 . "REGION"))))  you use this method  3 times, Are you sure you will always have those 3 types of objects, Region, Hatch, Insert.

 

Marc_AM Newbie

Marc_AM

Posted
  • Author
Posted
  On 3/27/2025 at 10:55 PM, BIGAL said:

Just a comment, there is no check for does this return nil (setq regioni1 (ssget "X" '((0 . "REGION"))))  you use this method  3 times, Are you sure you will always have those 3 types of objects, Region, Hatch, Insert.

 

Expand  

 

Thanks for your comment: I have to convert in this way several drawings and, all of them, they are similar to the dxf attacched to my first post and they have got Region and Hatch objects after exploding the Insert objects.

 

Today, I've completed the code and it runs quite well to the end but there are 2 problems:

 

1) While the code is running, it shows sometimes "Unknown Command" but, despite the error,  it goes to the end accomplishing all the tasks.

2) After creating the new blocks, the line (command "._erase" ss "") doesn't work and it doesn't erase the exploded blocks step by step. The exploded blocks stay on the drawing to the end (pict in attachment) but I have to delete them in some way.

 

Any suggestion?

 

  

(defun explodeinsert ()
   (setq w (ssname ss1 n))
   (setq a (entget w))
   (setq insertname (cdr (assoc '2 a)))
   (setq insertlayer (cdr (assoc '8 a)))
   (command ".-inser" insertname pt0 "" "" "")
   (setq ultimo (entlast))
   (ssadd ultimo ss2)
   (command "._explode" ss2 "")
   (ssdel ultimo ss2)	
   (keephatch)
   (setq n (1- n))
)
(defun keephatch ()	
   (setq ultimi (ssget "_p"))
   (setq n3 (1- (sslength ultimi)))
         (while (>= n3 0)
		    (progn
			   (setq w3 (ssname ultimi n3))
               (setq a3 (entget w3))
			   (setq name3 (cdr (assoc '0 a3)))
		       (if (= name3 "HATCH")
			      (progn
				     (setq hatchlayer (cdr (assoc '8 a3)))
				     (ssadd w3 ss3)
				     (command "._hatchgenerateboundary" ss3 "")
					 (ssdel w3 ss3)
					 (explodelwpoly)
					) 
		    	)
            )
           (setq n3 (1- n3))			
         )		 
)
(defun explodelwpoly ()
   (command "._explode" "p" "")
   (setq ss (ssget "_p"))
   (command "._change" ss "" "p" "l" insertlayer "")
   (setq ss (ssget "_p"))
   (obj2blk1)
)
(defun obj2blk1 ()

; Block name and base point
   (setq bn insertname)
   (setq pt '(0 0))

; Block header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

; Block entities
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
      (setq ent (ssname ss i) elist (entget ent))
      (entmake elist)
   )

; End block
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

; delete originals
   (command "._erase" ss "")

)
(defun c:hatch2blck ()
   (command "._zoom" "_a")
   (setq qaf (getvar "QAFLAGS"))
   (setvar "QAFLAGS" 1)
   (setq ss1 (ssget "X" '((0 . "INSERT"))))
   (setq ss2 (ssadd))
   (setq ss3 (ssadd))
   (setq n (1- (sslength ss1)))
   (setq quantiblocchi 0)
   (setq totblocchi (1+ n))
   (setq pt0 '(0 0))
   (while (>= n 0) (explodeinsert))
   (setq regioni (ssget "X" '((-4 . "<OR")
                                   (0 . "REGION")
								   (0 . "HATCH")
							  (-4 . "OR>")
							 )
                 )	
    )				 
   (command "._erase" regioni "")
   (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
   (setvar "QAFLAGS" qaf)
)

.

 

 

 

Appunti01.jpg

GLAVCVS Rising Star

GLAVCVS

Posted
Posted
  On 3/28/2025 at 9:15 PM, Marc_AM said:

 

Thanks for your comment: I have to convert in this way several drawings and, all of them, they are similar to the dxf attacched to my first post and they have got Region and Hatch objects after exploding the Insert objects.

 

Today, I've completed the code and it runs quite well to the end but there are 2 problems:

 

1) While the code is running, it shows sometimes "Unknown Command" but, despite the error,  it goes to the end accomplishing all the tasks.

2) After creating the new blocks, the line (command "._erase" ss "") doesn't work and it doesn't erase the exploded blocks step by step. The exploded blocks stay on the drawing to the end (pict in attachment) but I have to delete them in some way.

 

Any suggestion?

 

  

(defun explodeinsert ()
   (setq w (ssname ss1 n))
   (setq a (entget w))
   (setq insertname (cdr (assoc '2 a)))
   (setq insertlayer (cdr (assoc '8 a)))
   (command ".-inser" insertname pt0 "" "" "")
   (setq ultimo (entlast))
   (ssadd ultimo ss2)
   (command "._explode" ss2 "")
   (ssdel ultimo ss2)	
   (keephatch)
   (setq n (1- n))
)
(defun keephatch ()	
   (setq ultimi (ssget "_p"))
   (setq n3 (1- (sslength ultimi)))
         (while (>= n3 0)
		    (progn
			   (setq w3 (ssname ultimi n3))
               (setq a3 (entget w3))
			   (setq name3 (cdr (assoc '0 a3)))
		       (if (= name3 "HATCH")
			      (progn
				     (setq hatchlayer (cdr (assoc '8 a3)))
				     (ssadd w3 ss3)
				     (command "._hatchgenerateboundary" ss3 "")
					 (ssdel w3 ss3)
					 (explodelwpoly)
					) 
		    	)
            )
           (setq n3 (1- n3))			
         )		 
)
(defun explodelwpoly ()
   (command "._explode" "p" "")
   (setq ss (ssget "_p"))
   (command "._change" ss "" "p" "l" insertlayer "")
   (setq ss (ssget "_p"))
   (obj2blk1)
)
(defun obj2blk1 ()

; Block name and base point
   (setq bn insertname)
   (setq pt '(0 0))

; Block header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

; Block entities
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
      (setq ent (ssname ss i) elist (entget ent))
      (entmake elist)
   )

; End block
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

; delete originals
   (command "._erase" ss "")

)
(defun c:hatch2blck ()
   (command "._zoom" "_a")
   (setq qaf (getvar "QAFLAGS"))
   (setvar "QAFLAGS" 1)
   (setq ss1 (ssget "X" '((0 . "INSERT"))))
   (setq ss2 (ssadd))
   (setq ss3 (ssadd))
   (setq n (1- (sslength ss1)))
   (setq quantiblocchi 0)
   (setq totblocchi (1+ n))
   (setq pt0 '(0 0))
   (while (>= n 0) (explodeinsert))
   (setq regioni (ssget "X" '((-4 . "<OR")
                                   (0 . "REGION")
								   (0 . "HATCH")
							  (-4 . "OR>")
							 )
                 )	
    )				 
   (command "._erase" regioni "")
   (vla-regen (vla-get-ActiveDocument (vlax-get-acad-object)) acAllViewports)
   (setvar "QAFLAGS" qaf)
)

.

 

 

 

Appunti01.jpg

Expand  

 

If at any time AutoCAD shows "Unknown command" it is likely that it has stopped processing some object.

Stefan BMR Proficient

Stefan BMR

Posted
Posted (edited)

Hi Marc

 

Is there any difference between the region and the new generated boundary? If not, just delete the Hatch and explode the region.

 

Here is an example that does this. The lisp works inside the block definition, so no need to recreate it. 

(defun c:test ( / *error* acdoc blocks ss i b n block_list objname )
  (vl-load-com)
  
  (setq acdoc (vla-get-activedocument
                (vlax-get-acad-object)
              )
        blocks (vla-get-blocks acdoc)
  )
  
  (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (if msg
      (progn
        (if
          (not (wcmatch (strcase msg) "*EXIT*,*CANCEL*,*ABORT*"))
          (princ (strcat "\nERROR: " msg))
        )
      )
    )
    (vla-regen acdoc acactiveviewport)
    (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark acdoc))
    (princ)
  )

 
  (if
    (setq ss (ssget '((0 . "INSERT"))))
    (repeat (setq i (sslength ss))
      (setq b (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
      (setq n (vlax-get b (if (vlax-property-available-p b 'EffectiveName) 'EffectiveName 'Name)))
      (if
        (not (vl-position n block_list))
        (progn
          (setq block_list (cons n block_list))
          (vlax-for obj (vla-item blocks n)
            (setq objname (vla-get-objectname obj))
            (cond
              ((eq objname "AcDbHatch")
               (vla-delete obj)
              )
              ((eq objname "AcDbRegion")
               (vla-explode obj)
               (vla-delete obj)
              )
            )
          )
        )
      )
    )
  )

  (*error* nil)
  (princ)
)

 

Edited by Stefan BMR
Marc_AM Newbie

Marc_AM

Posted
  • Author
Posted

Hello Stefan, thanks for your suggestion. I've tried to run your code but it prompts this error:

no function definition: STOCK:ACDOC

 

I am not familiar with Visual Lisp then I've re-written my code in order to explode the Region instead of the Hatch.

Now it works much better, thank you!!!

 

I've also managed to solve the problem to erase all the exploded blocks by including another erasing routine.

Stefan BMR Proficient

Stefan BMR

Posted
Posted

Marc

 

I corrected the code above.

Use it carefully. Based on your sample, I assumed that there is always a hatch and a region. If the region is missing, the result would be an empty block.

 

 

Marc_AM Newbie

Marc_AM

Posted
  • Author
Posted

Hello Stefan,

thanks for the code. I am testing it and it runs much faster than mine.

I think I have to start studying Visual Lisp... ðŸ™‚

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...