Lisp routine to show visibilty splays

[BIG-AL]

Slightly different but can me altered to suit sight distance it uses a block for the car with wheelbase of 3.05, you could make it draw lines from the two points.

; veh driveway check draws multiple cars along a pline.
(Defun draw_vehicle ( )

(SETQ ANGBASEE (GETVAR "ANGBASE"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ LUNITSS (GETVAR "LUNITS"))
(SETQ LUPRECC (GETVAR "LUPREC"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(SETQ AUPRECC (GETVAR "AUPREC"))
(setq oldsnap (getvar "osmode"))

(SETVAR "LUNITS" 2)
(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "LUPREC" 0)
(SETVAR "AUNITS" 3)
(SETVAR "AUPREC" 0)
(setvar "osmode" 0)

(if (tblsearch "Block" "Holden")
(princ "Holden")
(progn
(command "Insert" "p:\\Autodesk\\vba\\holdencar.dwg" "0,0" 1 1 0)
(command "erase" "last" "")
) ; progn
)

(setq obj (vlax-ename->vla-object (car (entsel "\nPick Pline"))))

(setq interval ( getreal "\nEnter spacing m:")) ; use say 0.5m for numerous checks

(setq cRad 3.05)
(setq startang (* pi 1.5))
(setq endang (/ pi 2.0))
(setq dist 0.0)

(setq len (vla-get-length obj))
(setq stpt (vlax-curve-getpointatdist obj interval))

(setq num (+ 1 (fix ( / len interval))))

(repeat num

(command "arc" "C" stpt (polar stpt endang crad)(polar stpt startang crad))
(setq objarc (vlax-ename->vla-object (entlast)))

(if (= (setq intpt (vlax-invoke obj 'intersectWith objarc acExtendnone)) nil)
(setq intpt (vlax-invoke obj 'intersectWith objarc acExtendThisEntity)) ; needed at start
)

(vla-delete objarc)
(setq ang (angle intpt stpt))


(command "Insert" "Holden" stpt 1 1 ang) ; need ang in radians

(setq stpt (vlax-curve-getpointatdist obj (setq dist (+ dist interval))))

) ; repeat

(SETVAR "LUNITS" lunitss)
(SETVAR "ANGBASE" angbasee)
(SETVAR "ANGDIR" angdirr)
(SETVAR "LUPREC" luprecc)
(SETVAR "AUNITS" aunitss)
(SETVAR "AUPREC" auprecc)

(princ)



) ; defun


(draw_vehicle)

[davorin.potocnik800426]

Hi,

this is very useful.
I don't know a lot of lisp; maybe some day I'll have more time for learning about lisps.
I'm looking for change of you lisp but I don't know how to do that.
I would like to add one more condition and that is longitudinal slope.
For expamle; if longitudinal slope is +4% use: ldat '((20 . 15.5)(30 . 26.5)(40 . 40.0)(50 . 55.0)(60 . 72.0)(70 . 95.0)(80 . 121.0)(90 . 151.0)(100 . 187.0))
if longitudinal slope is -4% use another values and so on - I have 7 different longitudinal slopes.
I tried with cond but my knowledge is not good.
Could you help me about this?

Best regards

[Bruno.Valsecchi]

Hi,
Try for example to change this part in the lisp

 (setq
  ldat '((20 . 15.5)(30 . 26.5)(40 . 40.0)(50 . 55.0)(60 . 72.0)(70 . 95.0)(80 . 121.0)(90 . 151.0)(100 . 187.0))
  vlaobj (vlax-ename->vla-object (ssname js 0))
  perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
  pt_start (vlax-curve-getStartPoint vlaobj)
  pt_end (vlax-curve-getEndPoint vlaobj)
  d_x 0.0
  lst_pt nil
  pt_last nil
  env_mask (list pt_end)
  inc perim_obj
 )

by this, by adjusting the parameters and your lists to your desire.

 (initget "NEigth NFour NTwo Zero PTwo PFour PEigth") ;Ajust the key with your desired slope
 (setq slp (getkword "\nChoose slope [NEigth/NFour/NTwo/Zero/PTwo/PFour/PEeigth]? <Zero>: ")) ; And here also
 (if (not slp) (setq slp "Zero"))
 (setq
  ldat
   (cond
    ((eq slp "NEigth")
     ;replace this line with your list
    )
    ((eq slp "NFour")
     ;replace this line with your list
    )
    ((eq slp "NTwo")
     ;replace this line with your list
    )
    ((eq slp "Zero")
     ;replace this line with your list
    )
    ((eq slp "PTwo")
     ;replace this line with your list
    )
    ((eq slp "PFour")
     '((20 . 15.5)(30 . 26.5)(40 . 40.0)(50 . 55.0)(60 . 72.0)(70 . 95.0)(80 . 121.0)(90 . 151.0)(100 . 187.0))
    )
    ((eq slp "PEigth")
     ;replace this line with your list
    )
   )
  vlaobj (vlax-ename->vla-object (ssname js 0))
  perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
  pt_start (vlax-curve-getStartPoint vlaobj)
  pt_end (vlax-curve-getEndPoint vlaobj)
  d_x 0.0
  lst_pt nil
  pt_last nil
  env_mask (list pt_end)
  inc perim_obj
 )