Author Topic: need help for cross section offset and elevation label  (Read 1354 times)

0 Members and 1 Guest are viewing this topic.

Sudipta2020

  • Mosquito
  • Posts: 16
need help for cross section offset and elevation label
« on: September 08, 2020, 09:06:18 AM »
Hi everyone,

I want to plot label(offset and elevation) in cross section using lisp. already I used one lisp but in this lisp cross section position must in UCSW, is there any procedure without UCSW label can plot.

HOSNEYALAA

  • Newt
  • Posts: 103
Re: need help for cross section offset and elevation label
« Reply #1 on: September 08, 2020, 02:45:58 PM »
HI

Code: [Select]

 
(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))
  (setq lev (* 1(progn (initget 1) (getreal "\nSpecify elevation at starting vertex: ")))
datum(progn (initget 1) (getpoint "\nSpecify point for datum: ")))
 
  (setq VLIST1 (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget EN)))) EN 0)) (mapcar 'cdr (vl-remove-if  '(lambda ( x ) (/= (car x) 10)) (entget EN)))))
    (setq VLIST1(vl-sort
      VLIST1
                '(lambda(a b)(<(car a)(car b)))))
(setq x1(car(car VLIST1)))
(setq y1(cadr(car VLIST1)))
  (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)
   (setvar 'OSMODE 64)
(progn
   (initget "1 2")
   (setq
     l
      (cond
((getkword
   "\nGround 1 (1)/ Ground 2(2) < 1 > :"
)
)
("1")
      )
   )
 
(if (eq l "1")
(COMMAND "_layer" "_m" "chainage  Ground 1" "_c" "7" "" "")
(COMMAND "_layer" "_m" "Elev  Ground 1" "_c" "7" "" "")
       )
       (if (eq l "2")
(COMMAND "_layer" "_m" "chainage Ground 2" "_c" "7" "" "")
(COMMAND "_layer" "_m" "Elev  Ground 2" "_c" "7" "" "")
   )
)
  (setq httt "1"); hight text
  (setq gptx (getpoint "\nBasepoint for X axis: "))
  (setq gpty (getpoint "\nBasepoint for Y axis: "))
 
  (foreach ITEM NEWVLIST
    (setq XSTR (rtos (nth 0 ITEM) 2 2)
  YSTR (rtos (/ (nth 1 ITEM) 10) 2 2)
  ZSTR (rtos (nth 2 ITEM) 2 2)
  STR  (strcat XSTR (SPACES XSTR) YSTR (SPACES YSTR) ZSTR) ;_ strcat
    ) ; setq
;      (write-line STR F1)
 
 (command "style" "PMSF-TEXT 2" "Arial" "" "" "" "" "")
    (command "text" "_mc"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gptx))
     httt
     "0"
     (strcat (rtos (- (nth 0 ITEM) (car datum)) 2 2))
    )
    (command "text" "_mc"
     (list (+ (atof xstr) (/ (atof httt) 2.0)) (cadr gpty))
     httt
     "0"
     (strcat (rtos (/ (+ lev (- (nth 1 ITEM) Y1)) 1) 2 2))
    )
 
  ) ; 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:vv () (SETTING) (VERTEXT) (RESETTING) (princ)) ; c:nsl
 
(prompt "\nwritten by ENGR..Mr.Muhammad USMAN SOHAIL #03008342153")
(prompt "\nEnter VV to start")
 



Sudipta2020

  • Mosquito
  • Posts: 16
Re: need help for cross section offset and elevation label
« Reply #2 on: September 09, 2020, 01:05:51 AM »
Hi Hosneyalaa,
Thanks for your help. I request please check your lisp some vertex label data not show at proper position.

BIGAL

  • Swamp Rat
  • Posts: 1396
  • 40 + years of using Autocad
Re: need help for cross section offset and elevation label
« Reply #3 on: September 09, 2020, 01:19:15 AM »
The best answer would be to get a better product to start with rather than patching lots of answers together. Produce cross sections with volume reports subgrades shown and so much more. Long sections automatic plan matching view.

www.civilsitedesign.com.au


A man who never made a mistake never made anything

HOSNEYALAA

  • Newt
  • Posts: 103
Re: need help for cross section offset and elevation label
« Reply #4 on: September 09, 2020, 03:09:58 AM »
Attach the same SECTION that you are working on
I'm working on the same SECTION  that I attached to YOU first post
The problem will be scale

HOSNEYALAA

  • Newt
  • Posts: 103
Re: need help for cross section offset and elevation label
« Reply #5 on: September 09, 2020, 03:28:11 AM »
HI

Sudipta2020

  • Mosquito
  • Posts: 16
Re: need help for cross section offset and elevation label
« Reply #6 on: September 09, 2020, 04:34:48 AM »
OK