AutoLISP Beginner - automatic offset idea based on nearby plines

October 4

Hi all,

Been reading the forums for ages, but finally have a thing I'd like some help figuring out.

I mostly use CAD to do town planning parking work. Our company has a design style whereby we fill all the proposed parking bays with a certain colour polyline.

I made my first working LISP last week, which allows you to select the long line of the bay, then choose which side to make an offset line. Then it makes it the right thickness and also the right layer, and moves it to back, and then repeats so you can do many in quick sucessions:

See pics for example:

This is cool and enables me to do this for all the bays relatively quickly.

But, knowing how good LISPs can be, I was wondering if there was a way of automating it to do this for every single bay in the drawing.

Here's the current LISP:

(defun C:PBH ()
  (repeat 1000
  (command "pselect" pause "") ;select line
  (command "offset" "e" "n" "1" pause "") ;select offset side
  (command "pselect" "l" "") ;auto-select previous item
  (setq ss (ssget "I")) ;set item to ss 
  (command "_.chprop" ss "" "LT" "Bylayer" "LA" "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY" "") ;set item to layer
  (command "_pedit" ss "W" "2" "") ;set item to 2m width
  (command "pselect" "l" "") ;auto-select last item
  (command "draworder" "b" "" "") ;send item to back
    )
  (princ)
  )

I was thinking, if there was a way for the program to find all lines on the parking bay layer longer than 2m (to make it ignore the short ones at each end), and then automatically work out which side those short lines are so that it knows what side to make the fill line, and do this for every item.

Is there a get command or something which would assess which direction those short lines were facing, (they are touching the long line), and then run that command on everything.

Been really enjoying gradually learning how these work, I'm assuming this would make it a lot more complicated but I'm keen to experiment if it's possible.

Cheers

Edited October 4 by highrise_uk

October 4

Well done, onto a slippery slope though "I wonder if I can make a LISP that can do....."

We might need a sample of a drawing to check and confirm how you draw things.

I'll take a guess that the parking bay lines are unique in some way, perhaps on their own layer, so to set you off you might use ssget with a filter for the layer

(setq ParkingLines (ssget (list (cons 8 Parking-Lines-Layer))) )

and if you use (ssget "_X" ... ) it will select everything else you select in the first example ( see https://lee-mac.com/ssget.html - Lee Mac has a lot of excellent resources, same as this website, AfraLisp and The Swamp)

In your code you can then ditch the (repeat 1000) (by the way there are better ways but this can work) and use a while loop perhaps:

(setq acount 0)
(while (< acount (sslength ParkingLines))

... do stuff              
                
  (setq MyLine (ssname ParkingLines acount))
  (command "_.chprop" MyLine "" "LT" "Bylayer" "LA" "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY" "") ;set item to layer

....
                
  (setq acount (+ acount 1))
) ; end while

If it was me I'd perhaps create a selection set of the parking bay lines and loop through that set (as above), zoom to and highlighting each polyline in turn (use redraw -entity name- 3 to highlight, 4 to remove highlight), user can select side, draw the hatch and move on.

If the parking bay line is always [ shaped and a polyline you could automate the offset side by using the 1st point in the polyline definition as the offset selection.

If I remember after the weekend this might be an interesting on to look at

October 4

Welcome to the forums. ssget is what your looking for. you can use that to filter by entity type, layer, color basically anything in the DXF code. so all you really have to do is drag a window around everything to make one selection.

This will dump the dxf codes of a selected entity to the command line

;;----------------------------------------------------------------------------;;
;; Dump all DXF Group Data             
(defun C:DumpIt (/ ent)
  (while (setq ent (car (entsel "\nSelect Entity to Dump")))
    (mapcar 'print (entget ent '( "*")))
  )
  (princ)
)

Lee Mac has a great website going over all the ssget options

this will only select lines on "parking line" Layer - (setq ss (ssget '((0 . "LINE") (8 . "PARKING LINE"))))

from there you can use the end points to calculate the distance of said lines to filter down to the "long ones"

Took a little time to add a few QOL to your code.

(defun c:foo (/ s d p LastEnt SS en)
  ;; Tharwat 14. Dec. 2011 ;; Modified by Mhupp
  (setq SS (ssadd)) ;A blank selection set is need to add things to later
  (while (setq s (car (entsel "\nSelect entity: "))) ;keeps repeating the command if you keep selecting things
    (if (not (member (cdr (assoc 0 (entget s))) '("*LINE" "CIRCLE" "ARC" "ELLIPSE"))) ;checks to see if the selection is a type of entity in the list
      (progn                                                                          ;remove any if you want the command to prompt you to select again
        (prompt "\nCan't Offset Selected Object, Try again")
        (c:foo)  ; Call the command again for retry (recursion) if you rename this command rename it here to.
      )
      (progn
        (if (setq d (getdist "\nDistance of offset <1>: ")) ;getdist allows you to key in things like 12'6" or use your mouse.
		  (progn)               ;if d is set do nothing
		  (setq dist 1)         ;Else if the user presses Enter, set d to 1
		)			
        (setq p (getpoint "\nSpecify Offset Side: "))
        ;; Store the last entity created before the offset, Offset can create multiple entitys
        (setq LastEnt (entlast))
        (command "_.offset" d s p "")
        ;; Add all newly created entities to the selection set
        (while (setq en (entnext LastEnt))
          (ssadd en SS)
        )
        ;; Process the newly created Selection set
        (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) ;this will create a list of entity name in selection set SS
          (setq vlaEnt (vlax-ename->vla-object ent)) ;gets the visual list name of an entity
		  ;; Set color to "ByLayer"
          (vla-put-color vlaEnt acByLayer)
          ;; Set to the layer "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY"
          (vla-put-layer vlaEnt "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY")
          ;; Set width to 2
		  (vla-put-ConstantWidth vlaEnt 2.0) ;always good pratice to use real numbers and not integer
          (command "_.draworder" ent "back") 
        )
      )
    )
  )
  (princ)
)

Modified from here

Edited October 4 by mhupp

October 4

Included with CIV3D is a carparking dynamic block just stretch and makes bays etc .

Parking Tools - Imperial.dwg Parking Tools - Metric.dwg

Something I use may be useful.

carpark made simple.lsp

October 15

Hi all,

Thanks for the replies! Been busy so not had a chance to reply until now.

@Steven P cheers for the reply. Will investigate the while function, I'd read about it before but was in a rush to get this finished and the 1000x repeat seemed a useful but dirty way to go for now haha.

The plines are not [ shaped, each bay is made of 3 plines.

@mhupp thanks for this. Was helpful reading the code along with the notes.

However, it does not allow me to select the lines using this LISP. It says 'cant offset selected object'.

I tried this with a new DWG with a few polylines in and got the same result.

I have attached my LISP (i guess its more of a macro really, also requires Properties to be opened first to work, as PSELECT seems to not exist until that's happened) and a drawing file showing a snapshot of what I'm dealing with. The bays are initially drawn using KeyLINES and then exploded into polylines.

PARKING BAY HATCHER.lsp ParkingBaysTest.dwg

What I was thinking for this LISP is if there was a way of selecting all of the long lines of the bays into a selection set (by filtering the whole layer to lines over 2m long)...

... and then maybe some kinda foreach command which would cycle through them, zooming in and allowing a single click to run the offset/layer/width work on the line, with the only user input needed being selecting the offset side which then triggers the view to move to the next line, and repeat.

Basically what Steven said above!

Quote

If it was me I'd perhaps create a selection set of the parking bay lines and loop through that set (as above), zoom to and highlighting each polyline in turn (use redraw -entity name- 3 to highlight, 4 to remove highlight), user can select side, draw the hatch and move on.

Unless this can be automated somehow like in my original thought, by making the program work out which way the short lines are pointing... i was thinking since they're touching there must be some code which works out the entity and can work out the direction based on the co-ords of each end against the co-ords of the line we're looking to offset.

Cheers

Edited October 15 by highrise_uk

October 15

And this way?
You simply select the polyline (without the returns), this automatically detects the side to be offset.

(defun C:PBH ( / ss acadObj ename start_pt end_pt ang_ori ss_start ent_start pt_start pt_end vla_obj v1 v2 det_or offset_val nw_obj)
  (princ "\nSelect polyline.")
  (while
    (null
      (setq ss
        (ssget "_+.:E:S"
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
            (cons 8 "KTS_TRO_White")
          )
        )
      )
    )
  )
  (setq
    acadObj (vlax-get-acad-object)
    ename (ssname ss 0)
    start_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetStartParam ename))
    end_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetEndParam ename))
    ang_ori (angle start_pt end_pt)
  )
  (vla-ZoomWindow acadObj (vlax-3d-point start_pt) (vlax-3d-point end_pt))
  (setq
    ss_start 
    (ssget "_C"
      (mapcar '- start_pt '(0.25 0.25 0.0))
      (mapcar '+ start_pt '(0.25 0.25 0.0))
      (list
        (cons 0 "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        (cons 8 "KTS_TRO_White")
      )
    )
    ent_start (ssname (ssdel ename ss_start) 0)
    pt_start (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetStartParam ent_start))
    pt_end (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetEndParam ent_start))
    vla_obj (vlax-ename->vla-object ename)
  )
  (setq
    v1 (mapcar '- (polar start_pt ang_ori 1.0) pt_end)
    v2 (mapcar '- start_pt pt_end)
    det_or
    (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
      (append v1 v2)
    )
  )
  (cond
    ((< det_or 0.0) (setq offset_val -1))
    ((> det_or 0.0) (setq offset_val 1))
  )
  (vla-Offset vla_obj offset_val)
  (setq nw_obj (vlax-ename->vla-object (entlast)))
  (vla-put-Layer nw_obj "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY")
  (vla-put-Linetype nw_obj "ByLayer")
  (vla-put-ConstantWidth nw_obj 2)
  (sssetfirst nil (ssadd (entlast)))
  (ai_draworder "_back")
  (vla-ZoomPrevious acadObj)
  (prin1)
)

October 15

On 04/10/2024 at 21:15, Steven P said:
Well done, onto a slippery slope though "I wonder if I can make a LISP that can do....."

We might need a sample of a drawing to check and confirm how you draw things.

I'll take a guess that the parking bay lines are unique in some way, perhaps on their own layer, so to set you off you might use ssget with a filter for the layer

(setq ParkingLines (ssget (list (cons 8 Parking-Lines-Layer))) )

and if you use (ssget "_X" ... ) it will select everything else you select in the first example ( see https://lee-mac.com/ssget.html - Lee Mac has a lot of excellent resources, same as this website, AfraLisp and The Swamp)

In your code you can then ditch the (repeat 1000) (by the way there are better ways but this can work) and use a while loop perhaps:
(setq acount 0)
(while (< acount (sslength ParkingLines))

... do stuff              
                
  (setq MyLine (ssname ParkingLines acount))
  (command "_.chprop" MyLine "" "LT" "Bylayer" "LA" "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY" "") ;set item to layer

....
                
  (setq acount (+ acount 1))
) ; end while
If it was me I'd perhaps create a selection set of the parking bay lines and loop through that set (as above), zoom to and highlighting each polyline in turn (use redraw -entity name- 3 to highlight, 4 to remove highlight), user can select side, draw the hatch and move on.

If the parking bay line is always [ shaped and a polyline you could automate the offset side by using the 1st point in the polyline definition as the offset selection.

If I remember after the weekend this might be an interesting on to look at

Nice one for this. Have managed to improve it a little today.

(defun c:pbh3 ()
  (setq ParkingLines (ssget))
  (setq pt1 (getpoint "\nSelect offset side: "))
  (setq acount 0)
  (while (< acount (sslength ParkingLines))
    (setq MyLine (ssname ParkingLines acount))
    (command "offset" "e" "n" "1" MyLine pt1 "")
    (setq ss (ssget "L"))
    (command "_.chprop"		     ss
	     ""			     "LT"
	     "Bylayer"		     "LA"
	     "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY"
	     ""
	    )
    (command "_pedit" ss "W" "2" "")
    (command "_draworder" ss "" "b")
    (setq acount (+ acount 1))
  )
)

This makes it slightly quicker to do whole sides of the road at once.

From what I've read it seems that the length of polylines isn't necessarily stored anywhere that ssget can read (is this right? newbie question but I did try and look it up lol)

October 15

21 minutes ago, Tsuky said:

And this way?
You simply select the polyline (without the returns), this automatically detects the side to be offset.

(defun C:PBH ( / ss acadObj ename start_pt end_pt ang_ori ss_start ent_start pt_start pt_end vla_obj v1 v2 det_or offset_val nw_obj)
  (princ "\nSelect polyline.")
  (while
    (null
      (setq ss
        (ssget "_+.:E:S"
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
            (cons 8 "KTS_TRO_White")
          )
        )
      )
    )
  )
  (setq
    acadObj (vlax-get-acad-object)
    ename (ssname ss 0)
    start_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetStartParam ename))
    end_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetEndParam ename))
    ang_ori (angle start_pt end_pt)
  )
  (vla-ZoomWindow acadObj (vlax-3d-point start_pt) (vlax-3d-point end_pt))
  (setq
    ss_start 
    (ssget "_C"
      (mapcar '- start_pt '(0.25 0.25 0.0))
      (mapcar '+ start_pt '(0.25 0.25 0.0))
      (list
        (cons 0 "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        (cons 8 "KTS_TRO_White")
      )
    )
    ent_start (ssname (ssdel ename ss_start) 0)
    pt_start (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetStartParam ent_start))
    pt_end (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetEndParam ent_start))
    vla_obj (vlax-ename->vla-object ename)
  )
  (setq
    v1 (mapcar '- (polar start_pt ang_ori 1.0) pt_end)
    v2 (mapcar '- start_pt pt_end)
    det_or
    (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
      (append v1 v2)
    )
  )
  (cond
    ((< det_or 0.0) (setq offset_val -1))
    ((> det_or 0.0) (setq offset_val 1))
  )
  (vla-Offset vla_obj offset_val)
  (setq nw_obj (vlax-ename->vla-object (entlast)))
  (vla-put-Layer nw_obj "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY")
  (vla-put-Linetype nw_obj "ByLayer")
  (vla-put-ConstantWidth nw_obj 2)
  (sssetfirst nil (ssadd (entlast)))
  (ai_draworder "_back")
  (vla-ZoomPrevious acadObj)
  (prin1)
)

That is class!

So much in there way above my understanding but the fact it works means that the fully automatic thing I have in mind must be possible.

Just need to combine your automatic side detection process with a selection set can grab every line on the KTS_TRO_White layer that is over 1.8m long.

Plenty to sit and play with there.

Edited October 15 by highrise_uk

October 15

Without any selection, we can do like this:

(defun C:PBH ( / ss n ename lg acadObj start_pt end_pt ang_ori ss_start ent_start pt_start pt_end vla_obj v1 v2 det_or offset_val nw_obj)
  (setq ss
    (ssget "_X"
      (list
        (cons 0 "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        (cons 8 "KTS_TRO_White")
      )
    )
  )
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ename (ssname ss (setq n (1- n)))
          lg (vlax-curve-GetDistAtParam ename (vlax-curve-GetEndParam ename))
        )
        (if (< lg 1.81)
          (ssdel ename ss)
        )
      )
    )
  )
  (setq acadObj (vlax-get-acad-object))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ename (ssname ss (setq n (1- n)))
          start_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetStartParam ename))
          end_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetEndParam ename))
          ang_ori (angle start_pt end_pt)
        )
        (vla-ZoomWindow acadObj (vlax-3d-point start_pt) (vlax-3d-point end_pt))
        (setq
          ss_start 
          (ssget "_C"
            (mapcar '- start_pt '(0.25 0.25 0.0))
            (mapcar '+ start_pt '(0.25 0.25 0.0))
            (list
              (cons 0 "LWPOLYLINE")
              (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
              (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
              (cons 8 "KTS_TRO_White")
            )
          )
          ent_start (ssname (ssdel ename ss_start) 0)
          pt_start (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetStartParam ent_start))
          pt_end (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetEndParam ent_start))
          vla_obj (vlax-ename->vla-object ename)
        )
        (setq
          v1 (mapcar '- (polar start_pt ang_ori 1.0) pt_end)
          v2 (mapcar '- start_pt pt_end)
          det_or
          (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
            (append v1 v2)
          )
        )
        (cond
          ((< det_or 0.0) (setq offset_val -1))
          ((> det_or 0.0) (setq offset_val 1))
        )
        (vla-Offset vla_obj offset_val)
        (setq nw_obj (vlax-ename->vla-object (entlast)))
        (vla-put-Layer nw_obj "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY")
        (vla-put-Linetype nw_obj "ByLayer")
        (vla-put-ConstantWidth nw_obj 2)
        (sssetfirst nil (ssadd (entlast)))
        (ai_draworder "_back")
        (vla-ZoomPrevious acadObj)
      )
    )
  )
  (prin1)
)

October 15

What about this idea dragging a line over pairs, you can do more than one pairs say select a lot in one go. See red line in image.

October 16

13 hours ago, Tsuky said:

Without any selection, we can do like this:

(defun C:PBH ( / ss n ename lg acadObj start_pt end_pt ang_ori ss_start ent_start pt_start pt_end vla_obj v1 v2 det_or offset_val nw_obj)
  (setq ss
    (ssget "_X"
      (list
        (cons 0 "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        (cons 8 "KTS_TRO_White")
      )
    )
  )
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ename (ssname ss (setq n (1- n)))
          lg (vlax-curve-GetDistAtParam ename (vlax-curve-GetEndParam ename))
        )
        (if (< lg 1.81)
          (ssdel ename ss)
        )
      )
    )
  )
  (setq acadObj (vlax-get-acad-object))
  (cond
    (ss
      (repeat (setq n (sslength ss))
        (setq
          ename (ssname ss (setq n (1- n)))
          start_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetStartParam ename))
          end_pt (vlax-curve-GetPointAtParam ename (vlax-curve-GetEndParam ename))
          ang_ori (angle start_pt end_pt)
        )
        (vla-ZoomWindow acadObj (vlax-3d-point start_pt) (vlax-3d-point end_pt))
        (setq
          ss_start 
          (ssget "_C"
            (mapcar '- start_pt '(0.25 0.25 0.0))
            (mapcar '+ start_pt '(0.25 0.25 0.0))
            (list
              (cons 0 "LWPOLYLINE")
              (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
              (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
              (cons 8 "KTS_TRO_White")
            )
          )
          ent_start (ssname (ssdel ename ss_start) 0)
          pt_start (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetStartParam ent_start))
          pt_end (vlax-curve-GetPointAtParam ent_start (vlax-curve-GetEndParam ent_start))
          vla_obj (vlax-ename->vla-object ename)
        )
        (setq
          v1 (mapcar '- (polar start_pt ang_ori 1.0) pt_end)
          v2 (mapcar '- start_pt pt_end)
          det_or
          (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2)))
            (append v1 v2)
          )
        )
        (cond
          ((< det_or 0.0) (setq offset_val -1))
          ((> det_or 0.0) (setq offset_val 1))
        )
        (vla-Offset vla_obj offset_val)
        (setq nw_obj (vlax-ename->vla-object (entlast)))
        (vla-put-Layer nw_obj "PR-HATCH-PARKING BAY-RESIDENT PERMIT ONLY")
        (vla-put-Linetype nw_obj "ByLayer")
        (vla-put-ConstantWidth nw_obj 2)
        (sssetfirst nil (ssadd (entlast)))
        (ai_draworder "_back")
        (vla-ZoomPrevious acadObj)
      )
    )
  )
  (prin1)
)

Amazing, that works absolutely perfectly. Will be analysing the code to learn all the vlax stuff seems super effective, wasn't aware of those functions before.

Thanks a lot!!

Sign In

AutoLISP Beginner - automatic offset idea based on nearby plines

Recommended Posts

highrise_uk

Steven P

mhupp

BIGAL

highrise_uk

Tsuky

highrise_uk

highrise_uk

Tsuky

BIGAL

highrise_uk

Join the conversation

Tutorials

Forums

Activity