0 Members and 1 Guest are viewing this topic.
(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")