;;;Label contour polylines with their elevation. ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 3-16-96 ;;; Edited: 2-10-2011 ;;; (DEFUN c:clbl (/ onsegpt0 pt0 nent line1 line2 pt1 pt2 pt3 pt4 lwpts) (c:svlayr) (SETQ osnap_mode (GETVAR "osmode")) (SETVAR "osmode" 0) (IF (TBLSEARCH "style" "Standard") (SETVAR "textstyle" "Standard") ) ;_ end of if (IF uint nil (LOAD "uint" "\nFile UINT.LSP not loaded! ") ) ;_ end of IF (SETQ contprec (uint 1 "" "Contour label precision:" (IF contprec contprec 0 ) ;_ end of IF ) ;_ end of uint ) ;_ end of SETQ (IF txtsize NIL (LOAD "txtsize" "\nFile TXTSIZE.LSP not loaded! ")) (txtsize nil) (WHILE (SETQ nent (NENTSEL "\nPick contour at point to label")) (IF dimscl nil (LOAD "dimscl") ) ;_ end of if (dimscl) (IF (> (GETVAR "viewtwist") 0) (SETQ txt_twst (- (* PI 2) (GETVAR "viewtwist"))) (SETQ txt_twst (GETVAR "viewtwist")) ) ;_ end of if (SETQ pt0 (NTH 1 nent) line1 (ENTGET (CAR nent)) pt1 (CDR (ASSOC 10 line1)) ;;; txtht (IF do_cmud ;;; (* 0.0750 dimsc) ;;; (* 0.080 dimsc) ;;; ) ;_ end of if nent_layr (CDR (ASSOC 8 line1)) ) ;_ end of setq (COND ((EQ "LWPOLYLINE" (CDR (ASSOC 0 line1))) (SETQ conti (CDR (ASSOC 38 line1))) (SETQ lwpts (REVERSE (MEMBER (ASSOC 42 (REVERSE line1)) (REVERSE (MEMBER (ASSOC 10 line1) line1)))) ptcnt 0 ) ;_ end of setq (IF (AND (EQ (BOOLE 1 (CDR (ASSOC 70 line1)) 1) 1)(NOT (MEMBER (CAR lwpts) (CDR lwpts)))) (SETQ lwpts (APPEND lwpts (LIST (NTH 0 lwpts)(NTH 1 lwpts)(NTH 2 lwpts)(NTH 3 lwpts)))) ) (WHILE (AND (NOT (AND (< (DISTANCE (SETQ onsegpt0 (INTERS pt0 (POLAR pt0 (+ (ANGLE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (/ PI 2.0)) 100.0 ) ;_ end of polar (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)) nil ) ;_ end of inters ) ;_ end of setq (CDR (NTH ptcnt lwpts)) ) ;_ end of distance (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < (< (DISTANCE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < (< (DISTANCE pt0 onsegpt0) (/ (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) 6.0)) (EQUAL (- (SIN (ANGLE onsegpt0 (CDR (NTH ptcnt lwpts))))) (SIN (ANGLE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)))) 0.00001 ) ;_ end of EQUAL ) ;_ end of AND ) ;_ end of NOT (< ptcnt (- (LENGTH lwpts) 8)) (>= (LENGTH lwpts) 8) ) ;_ end of and (SETQ ptcnt (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt)) ) ;_ end of while (SETQ pt1 (CDR (NTH ptcnt lwpts)) pt2 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)) ) ;_ end of setq (IF debug_clbl (PROGN (COMMAND ".circle" pt0 50) (COMMAND ".circle" pt1 50) (COMMAND ".circle" pt2 50)) ) ;_ end of IF ) ((EQ "VERTEX" (CDR (ASSOC 0 line1))) (SETQ pt2 (CDR (ASSOC 10 (ENTGET (ENTNEXT (CDR (ASSOC -1 line1))))))) ) ((EQ "LINE" (CDR (ASSOC 0 line1))) (SETQ pt2 (CDR (ASSOC 11 line1)))) ((EQ "AECC_CONTOUR" (CDR (ASSOC 0 line1))) (SETQ pt2 (upoint 1 "" "Pick rotation angle" nil pt0))) ) ;cond (COND ((EQ "AECC_CONTOUR" (CDR (ASSOC 0 line1))) (SETQ conti (CDR (ASSOC 40 line1)) lang (ANGLE pt0 pt2) contz (RTOS conti 2 contprec) ) ;_ end of SETQ ) ((EQ "LWPOLYLINE" (CDR (ASSOC 0 line1))) (IF (AND (< (DISTANCE (SETQ onsegpt0 (INTERS pt0 (POLAR pt0 (+ (ANGLE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (/ PI 2.0)) 100.0 ) ;_ end of polar (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)) nil ) ;_ end of inters ) ;_ end of setq (CDR (NTH ptcnt lwpts)) ) ;_ end of distance (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < (< (DISTANCE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < (< (DISTANCE pt0 onsegpt0) (/ (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) 6.0)) (EQUAL (- (SIN (ANGLE onsegpt0 (CDR (NTH ptcnt lwpts))))) (SIN (ANGLE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)))) 0.00001 ) ;_ end of EQUAL ) ;_ end of AND (PROGN (SETQ conti (CDR (ASSOC 38 line1)) lang (ANGLE pt1 pt2) contz (RTOS conti 2 contprec) ) ;_ end of SETQ ) ;_ end of PROGN (PROGN (SETQ conti nil lang nil contz nil ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF ) (T (SETQ conti (CADDR pt1) lang (ANGLE pt1 pt2) contz (RTOS conti 2 contprec) ) ;_ end of SETQ ) ) ;_ end of COND (IF (AND conti lang contz) (PROGN (SETQ chkang (+ lang (GETVAR "viewtwist"))) (IF (OR (AND (> chkang 1.8675) (< chkang 5.009)) (AND (> chkang (+ (* 2 PI) 1.8675)) (< chkang (+ (* 2 PI) 5.009))) ) ;_ end of or (SETQ txang (* (/ (+ PI lang) 2 PI) 360)) (SETQ txang (* (/ lang 2 PI) 360)) ) ;if (IF gvpno nil (LOAD "gvpno") ) ;_ end of if (gvpno) (IF set_mjrg NIL (LOAD "SET_MJRG" "\nFile SET_MJRG.LSP not loaded! ")) (set_mjrg) (SETQ pt0 (TRANS (LIST (CAR pt0) (CADR pt0)) 0 1) pt1 (TRANS (LIST (CAR pt1) (CADR pt1)) 0 1) pt2 (TRANS (LIST (CAR pt2) (CADR pt2)) 0 1) llt (IF (OR (WCMATCH (STRCASE nent_layr) "CSTTPX##|*") (WCMATCH (STRCASE nent_layr) "CSTECX##|*")) "E" "-" ) ;_ end of if ;;; prod "CONT" ;removed in deferrence to "viewport numbered" minor group , e.g. "VI01" colr (IF (OR (WCMATCH (STRCASE nent_layr) "CSTTPX##|*") (WCMATCH (STRCASE nent_layr) "CSTECX##|*") (WCMATCH (STRCASE nent_layr) "CONTOUR*|*") do_cmud (< txtht 100.0) ) "1" "6" ) ;_ end of if ) ;setq (IF (NOT (EQ "AECC_CONTOUR" (CDR (ASSOC 0 line1)))) (SETQ pt0 (POLAR pt1 (ANGLE pt1 pt2) (DISTANCE pt1 pt0))) ) ;_ end of IF (COND ((EQ (REM conti 10) 0) (SETQ modf "TX10")) ((EQ (REM conti 5) 0) (SETQ modf "TX05")) ((EQ (REM conti 2) 0) (SETQ modf "TX02")) ((SETQ modf "TX01")) ) ;cond (SETQ dont_ask_ltyp T) (c:mklayr) (SETQ dont_ask_ltyp nil) (COMMAND ".text" "j" "mc" pt0 txtht txang contz) (SETQ cltxt (ENTGET (ENTLAST)) cltxt (SUBST (CONS 51 0.2618) (ASSOC 51 cltxt) cltxt) ) ;setq (ENTMOD cltxt) ) ;_ end of PROGN (PROGN (IF debug_clbl2 (PROGN (PRINC "\ndistance from projected point to 1st end < segment length = ") (PRINC (< (DISTANCE (SETQ onsegpt0 (INTERS pt0 (POLAR pt0 (+ (ANGLE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (/ PI 2.0)) 100.0 ) ;_ end of polar (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)) nil ) ;_ end of inters ) ;_ end of setq (CDR (NTH ptcnt lwpts)) ) ;_ end of distance (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < ) ;_ end of PRINC (PRINC "\ndistance from projected point to 2nd end < segment length = ") (PRINC (< (DISTANCE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) ) ;_ end of < ) ;_ end of PRINC (PRINC "\ndistance from picked point to projected point < 1/8th segment length = ") (PRINC (< (DISTANCE pt0 onsegpt0) (/ (DISTANCE (CDR (NTH ptcnt lwpts)) (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts))) 6.0)) ) ;_ end of PRINC (PRINC "\nprojected point lies on segment = ") (PRINC (EQUAL (- (SIN (ANGLE onsegpt0 (CDR (NTH ptcnt lwpts))))) (SIN (ANGLE onsegpt0 (CDR (NTH (+ (IF(>(ATOI(SUBSTR(GETVAR "ACADVER")1 2))17) 5 4) ptcnt) lwpts)))) 0.00001 ) ;_ end of EQUAL ) ;_ end of PRINC (PRINC) ) ;_ end of PROGN ) ;_ end of IF (PRINC "\nMissed! try again. ") (PRINC) ) ;_ end of PROGN ) ;_ end of IF ) ;while (c:rslayr) (SETVAR "osmode" osnap_mode) (PRINC) ) ;defun ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;