Jump to content

Lisp to select and hatch objects

pixel8er

By pixel8er
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pixel8er Community Regular

pixel8er

Posted
Posted (edited)

Hi all

I'm pretty new to Lisp and I'm trying to create one that will:

 

1. Let the user select multiple closed polylines they want to hatch

2. Set the specific layer for the polylines

2. Apply the hatch on a specific layer based on the user selected dimscale to the selected polylines

 

I've cobbled together something with bits and pieces from other peoples code after doing some reading. The code works at a basic level - most of the time - but I think is a bit cumbersome and could be improved.

 

Can anyone provide any tips on a smarter way to achieve this?

 

;;Type HPMU to create MULCH hatch on the correct layer 

(defun c:HPMU ()

(setvar "cmdecho" 0)
(setvar "expert" 5) 
(setq hsc (* 5(getvar "DIMSCALE")));;Hatch Scale
(setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))

(command "-layer" "Make" "L-MLCH-PATT-BDRY" "Plot" "No" "" "Colour" "6"   "" "description" "Mulch Hatch Boundary" "L-MLCH-PATT-BDRY" "")
(command "-layer" "Make" "L-MLCH-PATT" "Colour" "4" "" "description" "Mulch Hatch" "L-MLCH-PATT" "")

(setq sel1 (ssget))

(command "CHPROP" sel1 "" "Layer" "L-MLCH-PATT-BDRY" "")
(command "-layer" "set" "L-MLCH-PATT" "" "" "-hatch" "properties" "Dash" hsc "45" "select objects" "previous" "" "")

(setvar "cmdecho" 1)
(princ)
)

Edited by pixel8er
Link to comment
Share on other sites
  • Replies 26
  • Created
  • Last Reply

Top Posters In This Topic

  • Tharwat

    10

  • pixel8er

    8

  • Lee Mac

    6

  • BIGAL

    1

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Tharwat Grand Master

Tharwat

Posted
Posted

You can modify the routine to meet your extra needs if needed . :)

 

(defun c:Test (/ hsc ss i sset p1 p2)
 ;; Tharwat 25. 06. 2011
 (setq hsc (* 5 (getvar "DIMSCALE")))
 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (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" "Dash" hsc "" "")
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
 (princ)
)

Tharwat

Link to comment
Share on other sites
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

Hi Tharwat

Thanks for your reply. Yes that works much better.

 

I'm trying to put the items on specific layers. I want the hatch to be on layer L-MLCH-PATT and the hatch boundary to be on layer L-MLCH-PATT-BDRY. My code will do this but not sure if it's the best way and where to insert it in your code

?

 

(command "-layer" "Make" "L-MLCH-PATT-BDRY" "Plot" "No" "" "Colour" "6" "" "description" "Mulch Hatch Boundary" "L-MLCH-PATT-BDRY" "")

(command "-layer" "Make" "L-MLCH-PATT" "Colour" "4" "" "description" "Mulch Hatch" "L-MLCH-PATT" "")

 

Regards

Paul

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

Here it goes buddy . :)

 

(defun c:Test (/ hsc ss i sset p1 p2)
 (vl-load-com)
 ;; Tharwat 25. 06. 2011
 (setq hsc (* 5 (getvar "DIMSCALE")))
 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))
 (if (not (or (tblsearch "LAYER" "L-MLCH-PATT-BDRY")
              (tblsearch "LAYER" "L-MLCH-PATT")
          )
     )
   (progn
     (command "-layer"         "Make"           "L-MLCH-PATT-BDRY"
              "Plot"           "No"             ""
              "Colour"         "6"              ""
              "description"    "Mulch Hatch Boundary"
              "L-MLCH-PATT-BDRY"                ""
             )
     (command "-layer"      "Make"        "L-MLCH-PATT" "Colour"
              "4"           ""            "description" "Mulch Hatch"
              "L-MLCH-PATT" ""
             )
   )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (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)
            )
          )
           (progn
             (command "_.-hatch" "_s" sset "" "_P" "Dash" hsc "" "")
             (vla-put-layer
               (vlax-ename->vla-object (entlast))
               "L-MLCH-PATT"
             )
             (vla-put-layer
               (vlax-ename->vla-object sset)
               "L-MLCH-PATT-BDRY"
             )
           )
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
 (princ)
)

 

Tharwat

Link to comment
Share on other sites
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

That's perfect! Thanks so much Tharwat. I'll need to read up now on all the nifty bits of code you put in

Regards

Paul

Link to comment
Share on other sites
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

Hi Tharwat

I've noticed that the scale of the hatch is as expected for the first time - but after that when dimscale is changed the hatch scale is incorrect. It retains the previous dimscale information for the first time but then is correct for the current dimscale. Is this a cache thing?

Regards

Paul

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

Yes that's would be changed if you changed the annotative scale .

 

If you do not want to be changed just remove this line of code ...

 

 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))

 

When ever you change the scale of annotative scale the scale of the hatch would be increased .

Link to comment
Share on other sites
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

Sorry Tharwat I used the wrong description.

 

I want the user to use the annotation scale at bottom right to change the hatch scale. I rearranged 2 lines of code to correct this:

 

(setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))

(setq hsc (* 5 (getvar "DIMSCALE")))

 

Thanks again

Paul

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

Just a suggestion instead of (command "-layer" "set" "L-MLCH-PATT") use (setvar "clayer" "L-MLCH-PATT")

 

At start do (setq oldlayer (getvar "clayer")) and at end (setvar "clayer" oldlayer) this way you return to your starting layer. Using setvars is a better way than using command.

Link to comment
Share on other sites
  • 1 month later...
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

Hi again

Tharwat I'm hoping you read this. I would like to know if it's possible to achieve the same thing without using Visual LISP? The routine as it currently stands is below

 

;; Original code by Tharwat 25.06.2011

;; Type HPMU to create MULCH hatch 

(defun c:HPMU (/ hsc ss i sset p1 p2)
 (vl-load-com)

 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))
 (setq hsc (* 1 (getvar "DIMSCALE")))
 
 (if (not (or (tblsearch "LAYER" "L-MLCH-PATT-BDRY")
              (tblsearch "LAYER" "L-MLCH-PATT")
          )
     )
   (progn
     (command "-layer"         "Make"           "L-MLCH-PATT-BDRY"
              "Plot"           "No"             ""
              "Colour"         "6"              ""
              "description"    "Mulch Hatch Boundary"
              "L-MLCH-PATT-BDRY"                ""
             )
     (command "-layer"      "Make"        "L-MLCH-PATT" "Colour"
              "4"           ""            "description" "Mulch Hatch"
              "L-MLCH-PATT" ""
             )
   )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (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)
            )
          )
           (progn
             (command "_.-hatch" "_s" sset "" "_P" "Dash" hsc "45" "" "")
             (vla-put-layer
               (vlax-ename->vla-object (entlast))
               "L-MLCH-PATT"
             )
             (vla-put-layer
               (vlax-ename->vla-object sset)
               "L-MLCH-PATT-BDRY"
             )
           )
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
 (princ)
)

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

Try this ... :)

 

;; Original code by Tharwat 25.06.2011

;; Type HPMU to create MULCH hatch 
(defun c:HPMU (/ hsc ss i sset p1 p2 e e1)
 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))
 (setq hsc (* 1 (getvar "DIMSCALE")))

 (if (not (or (tblsearch "LAYER" "L-MLCH-PATT-BDRY")
              (tblsearch "LAYER" "L-MLCH-PATT")
          )
     )
   (progn
     (command "-layer"         "Make"           "L-MLCH-PATT-BDRY"
              "Plot"           "No"             ""
              "Colour"         "6"              ""
              "description"    "Mulch Hatch Boundary"
              "L-MLCH-PATT-BDRY"                ""
             )
     (command "-layer"      "Make"        "L-MLCH-PATT" "Colour"
              "4"           ""            "description" "Mulch Hatch"
              "L-MLCH-PATT" ""
             )
   )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (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)
            )
          )
           (progn
             (command "_.-hatch" "_s" sset "" "_P" "Dash" hsc "45" "")
             (entmod (subst (cons 8 "L-MLCH-PATT")
                            (assoc 8 (setq e (entget (entlast))))
                            e
                     )
             )
             (entmod (subst (cons 8 "L-MLCH-PATT-BDRY")
                            (assoc 8 (setq e1 (entget sset)))
                            e1
                     )
             )
           )
        )
     )
   )
   (princ "\n No closed Polylines found !! ")
 )
 (princ)
)

Tharwat

Link to comment
Share on other sites
pixel8er Community Regular

pixel8er

Posted
  • Author
Posted

Hi Tharwat

The code errors at the line

 

VLAX-CURVE-GETSTARTPOINT

 

I'm trying to get this code to work on AutoCAD Mac which has no Visual LISP functionality. Is there another way to do it?

 

Thanks

Paul

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted (edited) 
;; Original code by Tharwat 25.06.2011

;; Type HPMU to create MULCH hatch 
(defun c:HPMU (/ hsc ss i sset e e1)
 (setvar "dimscale" (/ 1.0 (getvar "CANNOSCALEVALUE")))
 (setq hsc (* 1 (getvar "DIMSCALE")))
 (if (not (or (tblsearch "LAYER" "L-MLCH-PATT-BDRY")
              (tblsearch "LAYER" "L-MLCH-PATT")
          )
     )
   (progn
     (command "-layer"         "Make"           "L-MLCH-PATT-BDRY"
              "Plot"           "No"             ""
              "Colour"         "6"              ""
              "description"    "Mulch Hatch Boundary"
              "L-MLCH-PATT-BDRY"                ""
             )
     (command "-layer"      "Make"        "L-MLCH-PATT" "Colour"
              "4"           ""            "description" "Mulch Hatch"
              "L-MLCH-PATT" ""
             )
   )
 )
 (if (setq ss (ssget "_:L" (list '(0 . "*POLYLINE")'(-4 . "&=")'(70 . 1))))
   (progn
     (repeat
       (setq i (sslength ss))
        (setq sset (ssname ss (setq i (1- i))));;; 
             (command "_.-hatch" "_s" sset "" "_P" "Dash" hsc "45" "")
             (entmod (subst (cons 8 "L-MLCH-PATT")
                            (assoc 8 (setq e (entget (entlast))))
                            e
                     )
             )
             (entmod (subst (cons 8 "L-MLCH-PATT-BDRY")
                            (assoc 8 (setq e1 (entget sset)))
                            e1
                     )
             )
           )
        )
   (princ "\n No closed Polylines found !! ")
 )
 (princ)
)

Tharwat

Edited by Tharwat
a bitwise mask added to codes as recommended by Lee
Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Tharwat,

 

Since DXF group 70 is a bit-coded value (for both LWPolylines and Polylines), you will need to add a bitwise mask (&=) to your ssget filter list, so that closed polylines with, for example, linetype generation on (70 . 129), can still be selected.

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