road x-section lisp problem

[cadamrao]

Sir,

 

Happy New Year sir,

 

I have a two Lisp program for draw road cross-section and longitudinal section. But this lisp is worked for only limited offsets (Table –I). But I need more offsets as per different site location of offsets, Existing Road Top and Existing FRL level (Table –II). I have no idea to modify this Lisp to number of offsets, so please modify and send email.

 

 

******************************************************
xs.lisp
(defun c:xs ()
(mapcar 'setvar '("cmdecho" "osmode" "filedia" "cmddia") '(0 0 0 0))
(COMMAND "LUPREC" 3)
(setq zz 0)
(setq ff (vl-directory-files "D:/road_csarea_rs" "*.csv"))
(while (< zz (length ff))
(setq fx (nth zz ff))
(setq scrpath (strcat "D:/road_csarea_rs/" fx) )
(if (null scrpath) (progn (princ "\n NO SCRIPT-File Selected.") (exit) ))
(initget 1)
(setq chain 0)
(setq fpath (vl-filename-directory scrpath) )
(command "-style" "standard" "ARIAL" 0 1 "" "" "" "")
(setq opfile (open scrpath "r") )
(setq rdline (read-line opfile) )
(while rdline
(setq xval (atof (txtlist rdline 1)) 
yval (atof (txtlist rdline 2))
zval (atof (txtlist rdline 3))
)
(setq n 1 
chlist (list xval) 
gllist (list yval)
fllist (list zval)
agllist (list (list xval yval))
afllist (list (list xval zval))
)
(while (and (<= n 10) (setq rdline (read-line opfile) ) )
(setq ch (list (atof (txtlist rdline 1))) )
(setq gl (list (atof (txtlist rdline 2))) )
(setq fl (list (atof (txtlist rdline 3))) )
(setq q1 (atof (txtlist rdline 1)))
(setq q2 (atof (txtlist rdline 2)))
(setq q3 (atof (txtlist rdline 3)))
(setq g1 (list q1 q2))
(setq t1 (list q1 q3))
(setq chlist (append chlist ch ))
(setq gllist (append gllist gl ) )
(setq fllist (append fllist fl) )
(setq agllist (append agllist (list g1) ) )
(setq afllist (append afllist (list t1) ) )
(setq afllistr (reverse afllist))
(setq flistf (append agllist afllistr))
(drawreg flistf) 
(setq area-pcc (cal-area) )
(setq n (1+ n) )
);end while-2
(setq datum1 (fix(car(vl-sort gllist '<))))
(setq datum (- (min datum1) 3))
(setq maxd1 (fix(car(vl-sort fllist '>))))
(setq maxd (max maxd1))
(setq inspt (list chain datum) )
(command "insert" (strcat "*" fpath "/temg_rs.dwg") inspt "" "")
(command "zoom" "e")
);end while
(setq dt (ssget "x" '((8 . "datum"))))
(setq datext (strcat "DATUM" " " ":" " " (RTOS datum) " " "M"))
(COMMAND "CHANGE" DT "" "" "" "" "" "" datext)
(setq ss datum)
(setq a 1)
(setq ss1 (+ datum 20))
(while (< ss maxd)
(setq txtp (list chain ss1))
(setq txt (rtos (+ datum a)))
(command "text" txtp "2" "0" txt)
(command "change" (entlast) "" "P" "la" "datumch" "")
(setq ss1 (+ ss1 20))
(setq a (+ a 1))
(setq ss (+ ss 1))
);end while
(setq dt (ssget "x" '((8 . "datumch"))))
(setq txtp2 (list (- chain 10) (cadr txtp)))
(command "move" dt "" txtp txtp2 "")
(placetxt)
(DRAWLINE)
(setq fle1 (- (strlen fx) 4))
(setq fin1 (substr fx 1 fle1))
(setq cs1 (ssget "x" '((0 . "text")(8 . "cs"))))
(setq cst (strcat "CROSS SECTION" "@" fin1 "Km"))
(COMMAND "CHANGE" cs1 "" "" "" "" "" "" cst)
(CLOSE opfile)
(setq fle (- (strlen scrpath) 4))
(setq fin (substr scrpath 1 fle))
(setq fnm (strcat fin ".dwg"))
(command "-wblock" fnm "" "0,0" "all" "" "n")
(COMMAND "LUPREC" 3)
(setq ptlist nil)
(setq ptlistf nil)
(setq ptlist1 nil)
(setq ptlist2 nil)
(setq ptlist3 nil)
(setq ptlist4 nil)
(setq zz (+ zz 1))
)
(mapcar 'setvar '("cmdecho" "osmode" "filedia" "cmddia") '(1 1 1 1))
)

(defun placetxt()
(setq m 0)
(repeat (length chlist)
(setq m1 (* (nth m chlist) 20) )
(setq cc (nth m chlist) )
(setq gl1 (nth m gllist) )
(setq fl1 (nth m fllist) )
(setq instxt0 (list m1 (- datum 47) ))
(setq instxt1 (list m1 (- datum 30) ))
(setq instxt2 (list m1 (- datum 13) ))
(setq xval (rtos cc))
(setq gl1 (rtos gl1))
(setq fl1 (rtos fl1))
(command "text" "j" "MC" instxt0 2 90 xval)
(command "change" (entlast) "" "p" "c" "9" "")
(command "text" "j" "MC" instxt1 2 90 gl1)
(command "change" (entlast) "" "p" "c" "6" "")
(command "text" "j" "MC" instxt2 2 90 fl1)
(command "change" (entlast) "" "p" "c" "3" "")
(setq m (+ m 1) )
);end repeat
(SETQ dTTEXT (SSGET "X" '((8 . "datumch"))))
(SETQ de 0)
(WHILE (< de (SSLENGTH dTTEXT))
(SETQ ENAMd (SSNAME dTTEXT de))
(SETQ TXT2 (fix(ATOF(CDR(ASSOC 1 (ENTGET ENAMd))))))
(command "luprec" 0)
(SETQ TT2 (strcat (RTOS TXT2) " " "---"))
(COMMAND "CHANGE" ENAMd "" "" "" "" "" "" TT2)
(SETQ de (+ de 1))
)
)
(DEFUN DRAWLINE()
(setq c 0)
(setq x1s 0)
(while (< c (LENGTH gllist))
(setq ent (nth c gllist))
(setq entf (nth c fllist))
(setq y1b datum)
(setq y2b (+ (* (- ent datum) 20) y1b))
(setq y2bf (+ (* (- entf datum) 20) y1b))
(setq top (list x1s y2b))
(setq topf (list x1s y2bf))
(setq bot (list x1s y1b))
(command "line" bot top "")
(setq c (+ c 1))
(if (< c (length chlist)) 
(progn
(setq x1s (* (nth c chlist) 20) )
)
(progn
(setq x1s (* (nth (- c 1) chlist) 20) )
(setq area (strcat "AREA = " (rtos area-pcc 2 3) "Sq.M"))
(command "text" "j" "tl" top 5 0 area)
(command "change" (entlast) "" "p" "c" "9" "")
)
)
(setq ptlist (append ptlist (list top)) )
(setq ptlistf (append ptlistf (list topf)) )
)
(command "pline")
(foreach no ptlist (command no))
(command "")
(command "change" (entlast) "" "p" "c" "1" "")
(command "pline")
(foreach no ptlistf (command no))
(command "")
(command "change" (entlast) "" "p" "c" "3" "")
(SETQ GTEXT (NTH 0 PTLIST))
)
(defun txtlist (txt n)
(setq count 1 space 1 result "")
(while (and (<= count (strlen txt)) (<= space n))
(setq charchk (substr txt count 1) )
(cond ((= charchk ",") (setq space (+ space 1) ) )
((= space n) (setq result (strcat result charchk) ) )
);end cond
(setq count (+ count 1) )
);end while
result
);end defun
(defun drawreg ( ptlist )
(command "layer" "m" "AREA" "")
(command "pline")
(foreach pt ptlist (command pt) )
(command "c")
(command "region" (entlast) "")
(setq enam-rg (entlast) )
);end defun
(defun cal-area ()
(setq regset (ssget "x" '((0 . "REGION") (8 . "AREA"))) )
(if regset (progn
(command "area" "obj" (entlast))
(setq getarea (getvar "area") )
(command "erase" regset "")
);end progn
(setq getarea 0.000)
);end if
getarea
);end defun

******************************************

Thanking you

 

Yours truly,

Madhava Rao

Edited December 10, 2013 by SLW210
Code Tags!

[bsamc2000]

It appears that there is a set csv file located in directory labeled "D:/road_csarea_rs/" that the lisp file reads from. You should be able to modify them directly.

 

Brian

[Lee Mac]

i'm not sure I understand your question and how it is related to this thread? Maybe I'm missing something?

[bsamc2000]

Can you post the csv files from the folder "D:/road_csarea_rs/"?

It looks like this is where the information is contained. With out it we can not help you.

[shakappil]

hi,madavaravo..............

please send to me lisp program for road x section........i am working as a draughtsman it will help for my job...............my ID:shakappil@gmail.com

[ReMark]

shakappil:

 

It is not a good idea to post your email address in a public forum.

 

You do realize the original post was made over 19 months ago don't you? It also looks like there was some confusion regarding a csv file that was never fully answered.

 

I doubt you'll get a reply.

[shakappil]

i need a lisp for make road longitudinal profile...............if you have lisp please send to me...image is in below it will help you what is i am asking..........

[eldon]

Well ReMark, don't just sit there!! Get on with it.

 

shakappil, that is a very complicated Lisp that you expect for free, and not really something that would be handed out. It would need customisation for you, and who else would want it? Why not try to find out how your example drawing was produced, and maybe you have to buy some software

[ReMark]

I see. No, I do not have such a lisp. If there is one available you might have to do an Internet search along the lines of "autolisp"+"longitudinal profile" and see if you get any hits. Maybe one of the Lisp gurus here might know of such a routine.

 

In the future, please refrain from double posting, OK? It just causes confusion. And it is usually not a good idea to add your question to the end of a thread started by someone else.

[ReMark]

eldon:

 

I haven't had my ten cups of coffee yet. I'm a bit slow this morning.

[ReMark]

Come to think of it, isn't the image considered a road profile and not a section?

[ReMark]

What data do you have available that can be used to create the profile? Do you have a csv file?

[ReMark]

Here's a link to a centerline profile lisp program. Maybe this will help. Otherwise you may need a whole different piece of software (not just plain AutoCAD).

 

http://cadtips.cadalyst.com/sections/center-line-profile

[gnanatheepan]

I need to create road cross section profile. if u have any idea about that please tell me. or send documnets

[ReMark]

Did you read this thread at all?

 

Did you try the centerline program lisp routine I provided a link to?

 

Send documents? What documents? What do you think CADTutor is, a software supplier? CT is a free AutoCAD Help site. We do not create software programs although we do have some talented members who can write lisp routines and VBA code.

 

Perhaps you should look into switching from plain AutoCAD to something like Civil 3D if you will be doing a lot of this type of work.

 

Maybe this might be of some help. It is a 30-day trial offer.

 

http://www.sitetopo.com/index.html

[Dua786]

hi shakappil,

did you get Lisp for Profile if you get,

So let me reply on my email.

adeelmuscat@yahoo.com

Thanking you,

I'm expecting your reply.

[MSasu]

Gentlemen, posting your e-mail addresses is just an open invitation for spammers. You may want to consider removing them.

[MSasu]

Sorry for confusion, Sanju2323 ; I don't have such routine to share.

My advice was just to remove your e-mail address from above post (now posts); if you show it publicly, it may get harvested on spam lists and wouldn’t be very comfortable to get your Inbox flooded by junk mails.

[Ish]

On 1/12/2008 at 10:09 AM, cadamrao said:

Sir,

 

Happy New Year sir,

 

I have a two Lisp program for draw road cross-section and longitudinal section. But this lisp is worked for only limited offsets (Table –I). But I need more offsets as per different site location of offsets, Existing Road Top and Existing FRL level (Table –II). I have no idea to modify this Lisp to number of offsets, so please modify and send email.

 

 

 

******************************************************
xs.lisp
(defun c:xs ()
(mapcar 'setvar '("cmdecho" "osmode" "filedia" "cmddia") '(0 0 0 0))
(COMMAND "LUPREC" 3)
(setq zz 0)
(setq ff (vl-directory-files "D:/road_csarea_rs" "*.csv"))
(while (< zz (length ff))
(setq fx (nth zz ff))
(setq scrpath (strcat "D:/road_csarea_rs/" fx) )
(if (null scrpath) (progn (princ "\n NO SCRIPT-File Selected.") (exit) ))
(initget 1)
(setq chain 0)
(setq fpath (vl-filename-directory scrpath) )
(command "-style" "standard" "ARIAL" 0 1 "" "" "" "")
(setq opfile (open scrpath "r") )
(setq rdline (read-line opfile) )
(while rdline
(setq xval (atof (txtlist rdline 1)) 
yval (atof (txtlist rdline 2))
zval (atof (txtlist rdline 3))
)
(setq n 1 
chlist (list xval) 
gllist (list yval)
fllist (list zval)
agllist (list (list xval yval))
afllist (list (list xval zval))
)
(while (and (<= n 10) (setq rdline (read-line opfile) ) )
(setq ch (list (atof (txtlist rdline 1))) )
(setq gl (list (atof (txtlist rdline 2))) )
(setq fl (list (atof (txtlist rdline 3))) )
(setq q1 (atof (txtlist rdline 1)))
(setq q2 (atof (txtlist rdline 2)))
(setq q3 (atof (txtlist rdline 3)))
(setq g1 (list q1 q2))
(setq t1 (list q1 q3))
(setq chlist (append chlist ch ))
(setq gllist (append gllist gl ) )
(setq fllist (append fllist fl) )
(setq agllist (append agllist (list g1) ) )
(setq afllist (append afllist (list t1) ) )
(setq afllistr (reverse afllist))
(setq flistf (append agllist afllistr))
(drawreg flistf) 
(setq area-pcc (cal-area) )
(setq n (1+ n) )
);end while-2
(setq datum1 (fix(car(vl-sort gllist '<))))
(setq datum (- (min datum1) 3))
(setq maxd1 (fix(car(vl-sort fllist '>))))
(setq maxd (max maxd1))
(setq inspt (list chain datum) )
(command "insert" (strcat "*" fpath "/temg_rs.dwg") inspt "" "")
(command "zoom" "e")
);end while
(setq dt (ssget "x" '((8 . "datum"))))
(setq datext (strcat "DATUM" " " ":" " " (RTOS datum) " " "M"))
(COMMAND "CHANGE" DT "" "" "" "" "" "" datext)
(setq ss datum)
(setq a 1)
(setq ss1 (+ datum 20))
(while (< ss maxd)
(setq txtp (list chain ss1))
(setq txt (rtos (+ datum a)))
(command "text" txtp "2" "0" txt)
(command "change" (entlast) "" "P" "la" "datumch" "")
(setq ss1 (+ ss1 20))
(setq a (+ a 1))
(setq ss (+ ss 1))
);end while
(setq dt (ssget "x" '((8 . "datumch"))))
(setq txtp2 (list (- chain 10) (cadr txtp)))
(command "move" dt "" txtp txtp2 "")
(placetxt)
(DRAWLINE)
(setq fle1 (- (strlen fx) 4))
(setq fin1 (substr fx 1 fle1))
(setq cs1 (ssget "x" '((0 . "text")(8 . "cs"))))
(setq cst (strcat "CROSS SECTION" "@" fin1 "Km"))
(COMMAND "CHANGE" cs1 "" "" "" "" "" "" cst)
(CLOSE opfile)
(setq fle (- (strlen scrpath) 4))
(setq fin (substr scrpath 1 fle))
(setq fnm (strcat fin ".dwg"))
(command "-wblock" fnm "" "0,0" "all" "" "n")
(COMMAND "LUPREC" 3)
(setq ptlist nil)
(setq ptlistf nil)
(setq ptlist1 nil)
(setq ptlist2 nil)
(setq ptlist3 nil)
(setq ptlist4 nil)
(setq zz (+ zz 1))
)
(mapcar 'setvar '("cmdecho" "osmode" "filedia" "cmddia") '(1 1 1 1))
)

(defun placetxt()
(setq m 0)
(repeat (length chlist)
(setq m1 (* (nth m chlist) 20) )
(setq cc (nth m chlist) )
(setq gl1 (nth m gllist) )
(setq fl1 (nth m fllist) )
(setq instxt0 (list m1 (- datum 47) ))
(setq instxt1 (list m1 (- datum 30) ))
(setq instxt2 (list m1 (- datum 13) ))
(setq xval (rtos cc))
(setq gl1 (rtos gl1))
(setq fl1 (rtos fl1))
(command "text" "j" "MC" instxt0 2 90 xval)
(command "change" (entlast) "" "p" "c" "9" "")
(command "text" "j" "MC" instxt1 2 90 gl1)
(command "change" (entlast) "" "p" "c" "6" "")
(command "text" "j" "MC" instxt2 2 90 fl1)
(command "change" (entlast) "" "p" "c" "3" "")
(setq m (+ m 1) )
);end repeat
(SETQ dTTEXT (SSGET "X" '((8 . "datumch"))))
(SETQ de 0)
(WHILE (< de (SSLENGTH dTTEXT))
(SETQ ENAMd (SSNAME dTTEXT de))
(SETQ TXT2 (fix(ATOF(CDR(ASSOC 1 (ENTGET ENAMd))))))
(command "luprec" 0)
(SETQ TT2 (strcat (RTOS TXT2) " " "---"))
(COMMAND "CHANGE" ENAMd "" "" "" "" "" "" TT2)
(SETQ de (+ de 1))
)
)
(DEFUN DRAWLINE()
(setq c 0)
(setq x1s 0)
(while (< c (LENGTH gllist))
(setq ent (nth c gllist))
(setq entf (nth c fllist))
(setq y1b datum)
(setq y2b (+ (* (- ent datum) 20) y1b))
(setq y2bf (+ (* (- entf datum) 20) y1b))
(setq top (list x1s y2b))
(setq topf (list x1s y2bf))
(setq bot (list x1s y1b))
(command "line" bot top "")
(setq c (+ c 1))
(if (< c (length chlist)) 
(progn
(setq x1s (* (nth c chlist) 20) )
)
(progn
(setq x1s (* (nth (- c 1) chlist) 20) )
(setq area (strcat "AREA = " (rtos area-pcc 2 3) "Sq.M"))
(command "text" "j" "tl" top 5 0 area)
(command "change" (entlast) "" "p" "c" "9" "")
)
)
(setq ptlist (append ptlist (list top)) )
(setq ptlistf (append ptlistf (list topf)) )
)
(command "pline")
(foreach no ptlist (command no))
(command "")
(command "change" (entlast) "" "p" "c" "1" "")
(command "pline")
(foreach no ptlistf (command no))
(command "")
(command "change" (entlast) "" "p" "c" "3" "")
(SETQ GTEXT (NTH 0 PTLIST))
)
(defun txtlist (txt n)
(setq count 1 space 1 result "")
(while (and (<= count (strlen txt)) (<= space n))
(setq charchk (substr txt count 1) )
(cond ((= charchk ",") (setq space (+ space 1) ) )
((= space n) (setq result (strcat result charchk) ) )
);end cond
(setq count (+ count 1) )
);end while
result
);end defun
(defun drawreg ( ptlist )
(command "layer" "m" "AREA" "")
(command "pline")
(foreach pt ptlist (command pt) )
(command "c")
(command "region" (entlast) "")
(setq enam-rg (entlast) )
);end defun
(defun cal-area ()
(setq regset (ssget "x" '((0 . "REGION") (8 . "AREA"))) )
(if regset (progn
(command "area" "obj" (entlast))
(setq getarea (getvar "area") )
(command "erase" regset "")
);end progn
(setq getarea 0.000)
);end if
getarea
);end defun

******************************************

 

 

Thanking you

 

Yours truly,

Madhava Rao

plz upload  in more detail , attach images also.

 

if u get any lisp to draw road cross section or profile , upload that.

thanks

[Ish]

On 7/26/2009 at 8:06 AM, shakappil said:

hi,madavaravo..............

please send to me lisp program for road x section........i am working as a draughtsman it will help for my job...............my ID:shakappil@gmail.com

if you get , upload here also.