Leaderboard

Looks like you got through it quicker than anticipated, I can stop drinking so much coffee now.

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

If lines can use Join command 1st for this request simpler for user to do join 1st and only write code for plines. Edit for desired layer name. (defun test (/ pt1 pt2 pt3 pt4 d1 d2 ss x1 y1 x2 y2 oldsnap oldlay) (setq oldsnap (getvar 'osmode)) (setq oldlay (getvar 'clayer)) ;(setvar 'clayer your layername) change to your layer name (setq lay (cdr (assoc 8 (entget (car (entsel "pick a pline")))))) (setq ss (ssget (list (cons 0 "lwpolyline") (cons 8 lay)))) (setvar 'osmode 0) (repeat (setq x (sslength ss)) (setq co-ord '()) (setq plent (ssname ss (setq x (1- x)))) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))) (if (= (length co-ord) 4) (progn (setq pt1 (nth 0 co-ord)) (setq pt2 (nth 1 co-ord)) (setq pt3 (nth 2 co-ord)) (setq pt4 (nth 3 co-ord)) (setq d1 (distance pt1 pt2)) (setq d2 (distance pt2 pt3)) (If (< d1 d2) (progn (setq x1 (/ (+ (car pt1) (car pt2)) 2.0)) (setq y1 (/ (+ (cadr pt1) (cadr pt2)) 2.0)) (setq x2 (/ (+ (car pt3) (car pt4)) 2.0)) (setq y2 (/ (+ (cadr pt3) (cadr pt4)) 2.0)) (command "line" (list x1 y1) (list x2 y2) "") ) (progn (setq x1 (/ (+ (car pt2) (car pt3)) 2.0)) (setq y1 (/ (+ (cadr pt2) (cadr pt3)) 2.0)) (setq x2 (/ (+ (car pt1) (car pt4)) 2.0)) (setq y2 (/ (+ (cadr pt1) (cadr pt4)) 2.0)) (command "line" (list x1 y1) (list x2 y2) "") ) ) ) (alert " Object has less or more than 4 sides\n \n So skipped") ) ) (setvar 'osmode oldsnap) (setvar 'clayer oldlay) (princ) ) (test)

Thanks supeeeeeeeeer

Are the rectangle lines or polylines? A sample drawing always helps (for me saved as 2010).

This happens to me every once in a while. When it does, I run an AUDIT. It never finds any errors but it clears out whatever is stopping the copy paste from working.

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

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.

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