help with cross section lisp

January 22, 2015

Hi i need help with a cross section lisp. I use *.txt files with distanse and elevetion to draw the polyline for the ground. I need help to do 2 things

1) draw the table under this polyline with the distanse and the elevetions

2) to add an opltion if i have 2 ground to add

Here is my code to modify.For more details look the example.dwg file and two ground files to do the test.

(Defun c:test ()
(setq g1 (getfiled "select ground1 file  L,H (*.txt)" "" "txt" 16))
(setq fil (open g1 "r"))
(COMMAND "_layer" "_m" "ground1" "_c" "94" "" "")
(COMMAND "_layer" "_m" "line" "_c" "9" "" "") ; The line must be dashdot
(COMMAND "_layer" "_m" "section table" "_c" "7" "" "")
(COMMAND "_layer" "_m" "Datum" "_c" "7" "" "")
(setq scl(/ (getreal  "\n give the scale (100,200,500,etc) : ") 100))
(setq ht(* 0.0018 scl)) ; text size
(setq oflin (* 0.012 scl)) ; offset lines
;I dont know how to add a questio at the begining like this
;If you want to draw ground1 select A / for ground2 select B

;(progn
;	   (initget "A B")
;	   (setq
;	     k
;	      (cond
;		((getkword
;		   "\nFor ground1 (Α)/ For ground2 (Β) < A > :"
;		 )
;		)
;		("A")
;	      )
;	   )
;

; from ground2
;
;(setq g2 (getfiled "select ground2 file  L,H (*.txt)" "" "txt" 16))
;(setq fil (open g2 "r"))
;(COMMAND "_layer" "_m" "ground2" "_c" "10" "" "")
;
;
(command "_.pline"); start Polyline
(while (setq lin (read-line fil)) (command lin)); feed in coordinates
(command ""); end Polyline
(close fil)

; I dont know how to draw the lines 


);End Defun

example.dwg

ground1 and ground2.dwg

ground1.txt

ground2.txt

Edited January 23, 2015 by prodromosm

January 22, 2015

any ideas ??

January 23, 2015

Try This Lisp

test.lsp

January 23, 2015

Hi sanju2323 nice code but i need same chances

1) i use grads so i have problem with the texts rotation

2) change text size by scale

3)An option to choose ground1/ground2

4) in post #1 i ask to choose for ground 1 automaticaly the datum and for the ground 2 to geve manualy the datum

5)Add layer ground1 for ground 1 elevetion and distance and ground 2 for ground2

Thanks

Edited January 23, 2015 by prodromosm

January 23, 2015

I try to change this but i have a text print problem

(defun ERR (S)
 (if (= S "Function cancelled")
   (princ "\nVERTEXT - cancelled: ")
   (progn (princ "\nVERTEXT - Error: ") (princ S) (terpri))
 )
 (RESETTING)
 (princ "SYSTEM VARIABLES have been reset\n")
 (princ)
)
(defun SETV (SYSTVAR NEWVAL)
 (setq X (read (strcat SYSTVAR "1")))
 (set X (getvar SYSTVAR))
 (setvar SYSTVAR NEWVAL)
)
(defun SETTING ()
 (setq OERR *ERROR*)
 (setq *ERROR* ERR)
 (SETV "CMDECHO" 0)
 (SETV "BLIPMODE" 0)
)
(defun RSETV (SYSTVAR)
 (setq X (read (strcat SYSTVAR "1")))
 (setvar SYSTVAR (eval X))
)

(defun RESETTING ()
 (RSETV "CMDECHO")
 (RSETV "BLIPMODE")
 (setq *ERROR* OERR)
)


(defun DXF (CODE ENAME) (cdr (assoc CODE (entget ENAME)))) ; dxf

(defun VERTEXT (/ EN VLIST)
 (setq EN (GET-EN))
 (if (= (DXF 0 EN) "LWPOLYLINE")
   (setq VLIST (GET-LWVLIST EN))
   (setq VLIST (GET-PLVLIST EN))
 )
 (WRITE-IT VLIST EN)
)

(defun GET-EN (/ NO-ENT EN MSG1 MSG2)
 (setq	NO-ENT 1
EN     NIL
MSG1   "\nSelect a polyline: "
MSG2   "\nNo polyline selected, try again."
 )					; setq
 (while NO-ENT
   (setq EN (car (entsel MSG1)))
   (if	(and EN
     (or (= (DXF 0 EN) "LWPOLYLINE") (= (DXF 0 EN) "POLYLINE"))
				; or
)				; and
     (progn (setq NO-ENT NIL))		; progn
     (prompt MSG2)
   )					; if
 )					; while
 EN
)					; get-en

(defun GET-LWVLIST (EN / ELIST NUM-VERT VLIST)
 (setq	ELIST	 (entget EN)
NUM-VERT (cdr (assoc 90 ELIST))
ELIST	 (member (assoc 10 ELIST) ELIST)
VLIST	 NIL
 )					; setq
 (repeat NUM-VERT
   (setq VLIST	(append VLIST (list (cdr (assoc 10 ELIST)))) ; append
   )					; setq
   (setq ELIST	(cdr ELIST)
  ELIST	(member (assoc 10 ELIST) ELIST)
   )					; setq
 )					; repeat
 VLIST
)					; get-lwvlist

(defun GET-PLVLIST (EN / VLIST)
 (setq	VLIST NIL
EN    (entnext EN)
 )					; setq
 (while (/= "SEQEND" (DXF 0 EN))
   (setq VLIST (append VLIST (list (DXF 10 EN))))
   (setq EN (entnext EN))
 )					; while
 VLIST
)					; get-plvlist

(defun WRITE-IT	(VLST EN / NEWVLIST MSG3 FNAME)
 (setq	NEWVLIST (mapcar '(lambda (X) (trans X EN 0)) ;_ lambda
		 VLST
	 ) ;_ mapcar
MSG3	 "Polyline vertex file"
				;FNAME    (getfiled MSG3 "" "txt" 1)
F1	 (open "FNAME" "w")
 )					; setq
 (WRITE-HEADER)
 (WRITE-VERTICES NEWVLIST)
 (setq F1 (close F1))
) ;_ write-it

(defun WRITE-HEADER (/ STR)
 (setq STR "        POLYLINE VERTEX POINTS")
 (write-line STR F1)
 (setq	STR (strcat "  X            " "  Y            " "  Z") ;_ strcat
 ) ;_ setq
 (write-line STR F1)
) ;_ write-header


(defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)
[color="red"] (COMMAND "_layer" "_m" "ground1" "_c" "94" "" "")
(setq scl(/ (getreal  "\n give the scale (100,200,500,etc) : ") 100))
(setq httt (* 0.018 scl))[/color]

 (setq gptx (getpoint "\nBasepoint for X axis: "))
 (setq gpty (getpoint "\nBasepoint for Y axis: "))

 (foreach ITEM	NEWVLIST
   (setq XSTR (rtos (nth 0 ITEM) 2 3)
  YSTR (rtos (nth 1 ITEM) 2 3)
  ZSTR (rtos (nth 2 ITEM) 2 3)
  STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
   )					; setq
				;      (write-line STR F1)



   (command "text"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx))
     httt
    [color="red"] "0"[/color]
     (strcat xstr)
   )
   (command "text"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty))
     httt
    [color="red"] "0"[/color]
     (strcat ystr)
   )

 )					; foreach

)					; write-vertices


(defun SPACES (STR / FIELD NUM CHAR SPACE)
 (setq	FIELD 15
NUM   (- FIELD (strlen STR))
CHAR  " "
SPACE ""
 ) ;_ setq
 (repeat NUM (setq SPACE (strcat SPACE CHAR))) ;_ repeat
) ;_ spaces

(defun C:Test2 () (SETTING) (VERTEXT) (RESETTING) (princ)) ; c:nsl

(prompt "\nEnter Test to start")

January 23, 2015

I update the code but i have a problem with the scale of the text

(defun ERR (S)
 (if (= S "Function cancelled")
   (princ "\nVERTEXT - cancelled: ")
   (progn (princ "\nVERTEXT - Error: ") (princ S) (terpri))
 )
 (RESETTING)
 (princ "SYSTEM VARIABLES have been reset\n")
 (princ)
)
(defun SETV (SYSTVAR NEWVAL)
 (setq X (read (strcat SYSTVAR "1")))
 (set X (getvar SYSTVAR))
 (setvar SYSTVAR NEWVAL)
)
(defun SETTING ()
 (setq OERR *ERROR*)
 (setq *ERROR* ERR)
 (SETV "CMDECHO" 0)
 (SETV "BLIPMODE" 0)
)
(defun RSETV (SYSTVAR)
 (setq X (read (strcat SYSTVAR "1")))
 (setvar SYSTVAR (eval X))
)

(defun RESETTING ()
 (RSETV "CMDECHO")
 (RSETV "BLIPMODE")
 (setq *ERROR* OERR)
)


(defun DXF (CODE ENAME) (cdr (assoc CODE (entget ENAME)))) ; dxf

(defun VERTEXT (/ EN VLIST)
 (setq EN (GET-EN))
 (if (= (DXF 0 EN) "LWPOLYLINE")
   (setq VLIST (GET-LWVLIST EN))
   (setq VLIST (GET-PLVLIST EN))
 )
 (WRITE-IT VLIST EN)
)

(defun GET-EN (/ NO-ENT EN MSG1 MSG2)
 (setq	NO-ENT 1
EN     NIL
MSG1   "\nSelect a polyline: "
MSG2   "\nNo polyline selected, try again."
 )					; setq
 (while NO-ENT
   (setq EN (car (entsel MSG1)))
   (if	(and EN
     (or (= (DXF 0 EN) "LWPOLYLINE") (= (DXF 0 EN) "POLYLINE"))
				; or
)				; and
     (progn (setq NO-ENT NIL))		; progn
     (prompt MSG2)
   )					; if
 )					; while
 EN
)					; get-en

(defun GET-LWVLIST (EN / ELIST NUM-VERT VLIST)
 (setq	ELIST	 (entget EN)
NUM-VERT (cdr (assoc 90 ELIST))
ELIST	 (member (assoc 10 ELIST) ELIST)
VLIST	 NIL
 )					; setq
 (repeat NUM-VERT
   (setq VLIST	(append VLIST (list (cdr (assoc 10 ELIST)))) ; append
   )					; setq
   (setq ELIST	(cdr ELIST)
  ELIST	(member (assoc 10 ELIST) ELIST)
   )					; setq
 )					; repeat
 VLIST
)					; get-lwvlist

(defun GET-PLVLIST (EN / VLIST)
 (setq	VLIST NIL
EN    (entnext EN)
 )					; setq
 (while (/= "SEQEND" (DXF 0 EN))
   (setq VLIST (append VLIST (list (DXF 10 EN))))
   (setq EN (entnext EN))
 )					; while
 VLIST
)					; get-plvlist

(defun WRITE-IT	(VLST EN / NEWVLIST MSG3 FNAME)
 (setq	NEWVLIST (mapcar '(lambda (X) (trans X EN 0)) ;_ lambda
		 VLST
	 ) ;_ mapcar
MSG3	 "Polyline vertex file"
				;FNAME    (getfiled MSG3 "" "txt" 1)
F1	 (open "FNAME" "w")
 )					; setq
 (WRITE-HEADER)
 (WRITE-VERTICES NEWVLIST)
 (setq F1 (close F1))
) ;_ write-it

(defun WRITE-HEADER (/ STR)
 (setq STR "        POLYLINE VERTEX POINTS")
 (write-line STR F1)
 (setq	STR (strcat "  X            " "  Y            " "  Z") ;_ strcat
 ) ;_ setq
 (write-line STR F1)
) ;_ write-header


(defun WRITE-VERTICES (NEWVLIST / XSTR YSTR ZSTR STR)

(progn
   (initget "A B")
   (setq
     k
      (cond
	((getkword
	   "\nFor ground1 (Α)/ For ground2 (Β) < A > :"
	 )
	)
	("A")
      )
   )
      
(if (eq k "A")
(COMMAND "_layer" "_m" "ground1" "_c" "94" "" "")
      )
      (if (eq k "B")
(COMMAND "_layer" "_m" "ground2" "_c" "10" "" "")
   )
)
[color="red"](setq sk (/ (getreal  "\n give the scale (100,200,500,etc) : ") 100))
(setq httt (* 0.0018 sk))[/color]
 (setq gptx (getpoint "\nBasepoint for X axis: "))
 (setq gpty (getpoint "\nBasepoint for Y axis: "))
 (foreach ITEM	NEWVLIST
   (setq XSTR (rtos (nth 0 ITEM) 2 3)
  YSTR (rtos (nth 1 ITEM) 2 3)
  ZSTR (rtos (nth 2 ITEM) 2 3)
  STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
   )					; setq
				;      (write-line STR F1)


(command "-style" "romans" "wgsimpl.shx" 0 1 0 "N" "N")
   (command "text"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx))
     httt
     "0"
     (strcat xstr)
   )
   (command "text"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty))
     httt
     "0"
     (strcat ystr)
   )

 )					; foreach

)					; write-vertices


(defun SPACES (STR / FIELD NUM CHAR SPACE)
 (setq	FIELD 15
NUM   (- FIELD (strlen STR))
CHAR  " "
SPACE ""
 ) ;_ setq
 (repeat NUM (setq SPACE (strcat SPACE CHAR))) ;_ repeat
) ;_ spaces

(defun C:Test () (SETTING) (VERTEXT) (RESETTING) (princ)) ; c:nsl

(prompt "\nEnter Test to start")

Can any one fix this

to choose for ground 1 automaticaly the datum and for the ground 2 to give manualy the datum

draw parallel lines with ( line offset = 0.012 *scale) and center the text between them like example.dwg ?

Thanks

Sign In

help with cross section lisp

Recommended Posts

Guest

Guest

sanju2323

Guest

Guest

Guest

Join the conversation

Tutorials

Forums

Activity