Jump to content

Hatch multy boundaries - help

mhy3sx

By mhy3sx
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

mhy3sx Collaborator

mhy3sx

Posted
Posted

Hi I am using this code to auto hatch multi boundaries by selecting all the boundaries in the same layer and hatch them.

 

I need two things.

 

Fist of all I dont know if is a faster way to do this because my code is repeated twice, one tome for each layer (I have two layers)

Second , I want to add a filter if in the boundary exist a hatch not add another. For exaple I add a new boundary in layer 1 don't hatch again all layer 1 boundaries, hatch only the new one

  

(defun c:foo (/ la ss i sset p1 p2)
(COMMAND "_layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")
(COMMAND "_layer" "_m" "H2" "_c" "90" "" "_lw" "0.05" "" "")

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
 
; <---- here repeat the code for layer A2 and hatch h2  
 
(command "-layer" "S" "H2" "")
 (if (setq ss (ssget "X" '((8 . "A2"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

;Hatch back
(setq hss (ssget "x" '((0 . "HATCH"))))
(command "draworder" hss "" "b") 

(princ)

;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))
(princ)
)

 

 

Thanks

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

Layer "m" - make option directly create layer and set it as current... So no need to do it set with another statement... But what is important you don't check if layer exist, so before all this, I'd use :

(if (not (tblsearch "LAYER" "H1"))

  (vl-cmdf "_.layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")

)

And the same for second paragraph...

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Is any way the code be shorter? In one "paragraph" search and hatch the tow type of polyline and hatches !!!

And check if the hatch already exist and skip this boundary

 

Thanks

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

You need to use a list with say 2 groups ((layername color hatch)(layername color hatch))

 

Then wrap the changes in a foreach. You need to change a few things. All these to recognise the current items, then only 1 routine but can have multiple layers. 

(foreach layhat lst

(COMMAND "_layer" "_m" (car layhat)  "_c" "10" "" "_lw" "0.05" "" "") ; put this inside foreach

(command "-layer" "S" (car layhat)  "") ; for me (setvar 'clayer (car layhat))

(command "_.-hatch" "_s" sset "" "_P" (caddr layhat)  0.20 50 "" "")

 

 

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Hi BIGAL. If I undestand is something like this 

  

(setq target_layers '("A1" "A2"))

(foreach layer_name target_layers
    (setq MySS (ssget "X" (list '(0 . "*POLYLINE") (8 . "A1" "Α2"))))
    (if MySS
      (progn
        (setq i 0)
        (repeat (sslength MySS)
          (setq ename (ssname MySS i))

           (command "-layer" "S" "Η1" "")
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")

           (command "-layer" "S" "Η2" "")
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
          (setq i (1+ i))
        )
      )
    )
  )

 

 

But how A1 polyline  ---> hatch in layer H1  and  A2 polyline  ---> hatch in layer H2 , and how if the A1 boundary have already a hatch (the code didn't hatch again ???)

 

Thanks

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Hi , I  try to do some changes. I have some layers to layoff on the beginning and layon at the end. Something is going wrong . Can any one help?

  

(defun c:test (/ la ss i sset p1 p2)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_off" "layer" "")
   )
 )

 (if (not (tblsearch "LAYER" "H1"))
  (vl-cmdf "_.layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")
) 

 (if (not (tblsearch "LAYER" "H2"))
  (vl-cmdf "_.layer" "_m" "H2" "_c" "90" "" "_lw" "0.05" "" "")
) 


(setq la (getvar "clayer")

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
(command "-layer" "S" "H2" "")
 (if (setq ss (ssget "X" '((8 . "A2"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

;Hatch back
(setq hss (ssget "x" '((0 . "HATCH"))))
(command "draworder" hss "" "b") 
(setvar "clayer" la)
)
(princ)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_on" "layer" "")
   )
 )


;Αλλαγη layer στο 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))

(princ)
)

 

 

Thanks

 

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted

You have quite few mistakes... One that I saw with a blink of an eye :

 

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")

  (if (tblsearch "layer" layer)

    (command "_layer" "_on" "layer" "")

  )

)

 

should be :

 

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")

  (if (tblsearch "layer" layer)

    (command "_layer" "_on" layer "")

  )

)

 

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

I did this change but code don't  run. Can any one help?

  

(defun c:test (/ la ss i sset p1 p2)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_off" layer "")
   )
 )

 (if (not (tblsearch "LAYER" "H1"))
  (vl-cmdf "_.layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")
) 

 (if (not (tblsearch "LAYER" "H2"))
  (vl-cmdf "_.layer" "_m" "H2" "_c" "90" "" "_lw" "0.05" "" "")
) 


(setq la (getvar "clayer")

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

(command "-layer" "S" "H2" "")
 (if (setq ss (ssget "X" '((8 . "A2"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

;Hatch back
(setq hss (ssget "x" '((0 . "HATCH"))))
(command "draworder" hss "" "b") 
(setvar "clayer" la)
)
(princ)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_on" layer "")
   )
 )


;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))

(princ)
)

 

Thanks

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Your not grasping the idea of using a list, each group item has all the setting for only one set of options. 

 

So in a loop, read a group of items from the list,

make a new layer

select plines on that layer 

hatch those plines with a hatch pattern and scale.

 

repeat again for the next group of items

 

Again "You need to use a list with say 2 groups ((layername color hatch)(layername2 color2 hatch2))" can have more than 2 or just 1.

 

Please try again we are here to help.

 

You have  

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))

So these and following code are inside a loop

(repeat (length lst)
(command "-layer" "S" (car (nth x lst)) "")
(if (setq ss (ssget "X" '((8 . (car (nth x lst)))))

 

Edited by BIGAL
Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Hi Marko_Ribar.I know that you are trying to help me but I am confiuzed. I don't have any    nth or  lst  in my code, I can not understand !!!!!

 

So far this is the code and is not running ...I can not understand way ........

And I ask

 

1) Is any way the code be shorter? In one "paragraph" search and hatch the tow type of polyline and hatches !!!

2) Check if the hatch already exists in some boundaries skip them and hatch only the empty boundaries.

 

  

(defun c:test (/ la ss i sset p1 p2)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_off" layer "")
   )
 )

 (if (not (tblsearch "LAYER" "H1"))
  (vl-cmdf "_.layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")
) 

 (if (not (tblsearch "LAYER" "H2"))
  (vl-cmdf "_.layer" "_m" "H2" "_c" "90" "" "_lw" "0.05" "" "")
) 


(setq la (getvar "clayer")

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

(command "-layer" "S" "H2" "")
 (if (setq ss (ssget "X" '((8 . "A2"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

;Hatch back
(setq hss (ssget "x" '((0 . "HATCH"))))
(command "draworder" hss "" "b") 
(setvar "clayer" la)
)
(princ)

(foreach layer '("LAYER1" "LAYER2" "LAYER3" "LAYER4")
   (if (tblsearch "layer" layer)
   (command "_layer" "_on" layer "")
   )
 )


;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))

(princ)
)

 

 

Thanks

Link to comment
Share on other sites
mhy3sx Collaborator

mhy3sx

Posted
  • Author
Posted

Ok now the code works. 

Is there some way to check if the hatch already exists on certain boundaries, and skip them and only hatch the empty boundaries.

 

  

(defun c:test (/ la ss i sset p1 p2)

 (if (not (tblsearch "LAYER" "H1"))
  (vl-cmdf "_.layer" "_m" "H1" "_c" "10" "" "_lw" "0.05" "" "")
) 

 (if (not (tblsearch "LAYER" "H2"))
  (vl-cmdf "_.layer" "_m" "H2" "_c" "90" "" "_lw" "0.05" "" "")
) 


    (foreach layer '( "LAYER1" "LAYER2" "LAYER3" "LAYER4")

        (if (tblsearch "layer" layer)
         (command "_layer" "off" layer "")
         
        )
    )



(setq la (getvar "clayer")

(command "-layer" "S" "H1" "")
 (if (setq ss (ssget "X" '((8 . "A1"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "LINE" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

(command "-layer" "S" "H2" "")
 (if (setq ss (ssget "X" '((8 . "A2"))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))))
        (if
          (and
            (eq (car (setq p1 (cdr (vlax-curve-getStartPoint sset))))
                (car (setq p2 (cdr (vlax-curve-getEndPoint sset))))
            )
            (eq (cadr p1)
                (cadr p2)
            )
          )
           (command "_.-hatch" "_s" sset "" "_P" "NET" 0.20 50  "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )

;Hatch back
(setq hss (ssget "x" '((0 . "HATCH"))))
(command "draworder" hss "" "b") 
(setvar "clayer" la)
)
(princ)

    (foreach layer '( "LAYER1" "LAYER2" "LAYER3" "LAYER4")

        (if (tblsearch "layer" layer)
         (command "_layer" "on" layer "")
         
        )
    )


;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight")  (list "0" "BYLAYER" "BYLAYER" -1))

(princ)
)

 

 

Thanks

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Another suggestion getting there.

  


(setq lst (list (list "H1" "10") (list "H2" "90")))

(foreach lay lst
  (if (not (tblsearch "LAYER" (car lay)))
    (vl-cmdf "_.layer" "_m" (car lay) "_c" (cadr lay) "" "_lw" "0.05" "" "")
  ) 
)

Just me I use setvar. 

(command "-layer" "S" "H1" "")

(setvar 'clayer "H1")

 

Re nth question if you have a list with say 100 items in it you use the NTH function, (nth 12 lst), will return the 13th item, yes 13 as the 1st item is (nth 0 lst), (last lst) will get the last item in the list.

 

Ok your home work is you can use a boundary as part of a ssget, one method is, (setq ss (ssget "wp" pts '((0 . "HATCH")) )) so it will find a hatch or not inside a boundary list of points.

 

Here is get pts of a pline. 

(setq plent (entsel "\nPick rectang"))
(if plent (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(setq pts (cons (last pts) pts)) ; closes list of points
(princ pts)

 

Link to comment
Share on other sites

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...