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 cs ()
(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

[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

[murtazachd]

hi
please tell me about temg_rs.dwg

************************************************** ****
xs.lisp
(defun cs ()
(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[/quote]

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