Jump to content
keiths

Lisp routine to create chevron markings

Recommended Posts

keiths

Hi,

 

 

Where can i find a lisp routine to create chevrons as used on gores or median islands.

Share this post


Link to post
Share on other sites
ReMark

I think CadTools has a chevron feature.

Share this post


Link to post
Share on other sites
BIGAL

Have a play with this not really finished but.

 

; chevron island creater
; this use the extrim command to trim shape
; By Alan H Jan 2012
(defun C:Chevron ( / obj pt1 pt2 pt3 pt4 newpt1 newpt2 )
(acet-error-init (list
                  (list   "cmdecho" 0
                        "highlight" 0
                        "regenmode" 1
                           "osmode" 0
                          "ucsicon" 0
                       "offsetdist" 0
                           "attreq" 0
                         "plinewid" 0
                        "plinetype" 1
                         "gridmode" 0
                          "celtype" "CONTINUOUS"
                        "ucsfollow" 0
                         "limcheck" 0
                  )
                  T     ;flag. True means use undo for error clean up.
                  '(if redraw_it (redraw na 4))
                 );list
);acet-error-init
(setq obj (car (entsel "\nPick pline or circle")))
; should do a object test here
(setq whatis (cdr (assoc 0 (entget obj))))
(if (= whatis "LWPOLYLINE")
(princ)
(progn
(princ "\You have picked something other than a polyline ")
(princ "\Remake into a pline and do again ")
(setq dummy (getstring "\press any key"))
(exit)
) ; progn
) ; if
(setq pt1 (Getpoint "\nPick Line start point"))
(setq pt2 (Getpoint pt1 "\nPick end point"))
(command "line" pt1 pt2 "")
(setq gap1 (getreal "\nenter spacing 1"))
(setq gap2 (getreal "\nenter spacing 2"))
(setq pt3 (getpoint "\nPick 1st cross point"))
(setq pt4 (getpoint pt3 "\nPick 2nd cross point"))
(setq dist (distance pt3 pt4))
(setq x (fix (/ dist (+ gap1 gap2))))
(setq newpt1 (strcat (rtos gap1 2 2) ",0.0"))
(setq newpt2 (strcat (rtos gap2 2 2) ",0.0"))
(repeat x 
(command "copy" "L" "" "0,0" newpt1)
(command "copy" "L" "" "0,0" newpt2)
)
(load "Extrim")
(etrim obj pt1)
(acet-error-restore)
) ; end defun

(princ)

Screen Shot 05-25-17 at 01.50 PM.jpg

Share this post


Link to post
Share on other sites
BIGAL

Readable version below, Maunsell is a very large engineering company obviously in Adelaide Australia. Not sure if it was to be released to the public.

 

; removed as I dont want to be sued by Maunsell's

Share this post


Link to post
Share on other sites
yathishkumar

Thank you for your reply and changed to Readable version bigal sir.

But actually​ I don't about Maunsell now I understood.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×