;;;Place a fixed radius DMS angle dim. (w/o DIM). Fills in leading zeros. ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 5-28-96 ;;; Edited: 1-25-2013 ;;; ;;; Separated "Label/Display" and format prompts , added option to label in degrees. ;;; (DEFUN mhang_error (msg /) (IF clayer (SETVAR "clayer" clayer) ) ;_ end of IF (IF old_mhang_error (SETQ *error* old_mhang_error) (SETQ *error* NIL) ) ;_ end of IF (PRINC (STRCAT "\nERROR: " (IF msg msg "" ) ;_ end of IF " MHANG aborted! " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:mhang (/) (SETQ old_mhang_error *error*) (SETQ *error* mhang_error) (SETQ clayer (GETVAR "clayer")) (SETQ vwtwst (GETVAR "viewtwist")) (SETQ adtrot (ANGTOS (- 0 vwtwst) 0 4)) (makedimaro) (IF dimscl nil (LOAD "dimscl" "\nFile DIMSCL.LSP not loaded! ") ) ;_ end of if (dimscl) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (SETQ lblordisp (ukword 1 "Label Display" "Do you want to abel the angle or just isplay it?" (IF lblordisp lblordisp "Label" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (SETQ printit (ukword 1 "DMS DEgrees" (STRCAT lblordisp " angle in or grees?") (IF printit printit "DMS" ) ;_ end of IF ) ;_ end of ukword ) ;_ end of SETQ (IF (EQ (STRCAT lblordisp) "DISPLAY") NIL (PROGN (IF txtsize nil (LOAD "txtsize" "File TXTSIZE.LSP not loaded!") ) ;_ end of IF (txtsize nil) (SETQ templ (ATOF thts)) ) ;_ end of PROGN ) ;_ end of IF ;;; (SETQ templ (ureal 1 ;;; "" ;;; "Text template size? " ;;; (IF templ ;;; templ ;;; 87.5 ;;; ) ;_ end of IF ;;; ) ;_ end of ureal ;;; ) ;_ end of SETQ ;;; ) ;_ end of if (c:svlayr) (SETQ cnt 1) (WHILE (SETQ line1 (NENTSELP "\nSelect first line: ")) (SETQ line2 (NENTSELP "\nSecond line: ")) (WHILE (AND (NOT (= (CDR (ASSOC 0 (ENTGET (CAR line1)))) "VERTEX")) (NOT (= (CDR (ASSOC 0 (ENTGET (CAR line1)))) "LINE")) ) ;and (SETQ line1 (NENTSEL "\nSelect first line: ")) ) ;while (WHILE (AND line1 line2 (NOT (= (CDR (ASSOC 0 (ENTGET (CAR line2)))) "VERTEX")) (NOT (= (CDR (ASSOC 0 (ENTGET (CAR line2)))) "LINE")) ) ;and (SETQ line2 (NENTSEL "\nSecond line: ")) ) ;while (SETQ ename1 (CAR line1) lpic1 (CADR line1) lent1 (ENTGET ename1) ename2 (CAR line2) lpic2 (CADR line2) lent2 (ENTGET ename2) ) ;setq (IF (= (CDR (ASSOC 0 lent1)) "VERTEX") (SETQ lpnt1 (LIST (CADR (ASSOC 10 lent1)) (CADDR (ASSOC 10 lent1))) ;0 ename1a (ENTNEXT ename1) lent1a (ENTGET ename1a) lpnt1a (LIST (CADR (ASSOC 10 lent1a)) (CADDR (ASSOC 10 lent1a))) ;0 ) ;setq (SETQ lpnt1 (LIST (CADR (ASSOC 10 lent1)) (CADDR (ASSOC 10 lent1))) ;0 lpnt1a (LIST (CADR (ASSOC 11 lent1)) (CADDR (ASSOC 11 lent1))) ;0 ) ;setq ) ;if (IF (= (CDR (ASSOC 0 lent2)) "VERTEX") (SETQ lpnt2 (LIST (CADR (ASSOC 10 lent2)) (CADDR (ASSOC 10 lent2))) ;0 ename2a (ENTNEXT ename2) lent2a (ENTGET ename2a) lpnt2a (LIST (CADR (ASSOC 10 lent2a)) (CADDR (ASSOC 10 lent2a))) ;0 ) ;setq (SETQ lpnt2 (LIST (CADR (ASSOC 10 lent2)) (CADDR (ASSOC 10 lent2))) ;0 lpnt2a (LIST (CADR (ASSOC 11 lent2)) (CADDR (ASSOC 11 lent2))) ;0 ) ;setq ) ;if (IF (AND lpnt1 lpnt1a (EQUAL lpnt1 lpnt1a) lpnt2) (SETQ lpnt1a lpnt2) ) ;_ end of IF (IF (SETQ avert (INTERS lpnt1 lpnt1a lpnt2 lpnt2a nil)) nil (COND ((EQUAL lpnt1 lpnt2) (SETQ avert lpnt1)) ((EQUAL lpnt1 lpnt2a) (SETQ avert lpnt1)) ((EQUAL lpnt1a lpnt2) (SETQ avert lpnt1a)) ((EQUAL lpnt1a lpnt2a) (SETQ avert lpnt1a)) ((EQUAL lpnt2 lpnt2a) (SETQ avert lpnt2a)) ) ;cond ) ;if (IF (NOT avert) (ALERT "The intersection for this angle was not determined!\nCheck for duplicate endpoints.") (PROGN (IF (> (DISTANCE lpnt1 avert) (DISTANCE lpnt1 lpic1)) (SETQ apnt1 lpnt1) (SETQ apnt1 lpnt1a) ) ;if (IF (> (DISTANCE lpnt2 avert) (DISTANCE lpnt2 lpic2)) (SETQ apnt2 lpnt2) (SETQ apnt2 lpnt2a) ) ;if (SETQ avec1 (ANGLE avert apnt1) avec2 (ANGLE avert apnt2) ) ;setq (IF (> avec1 avec2) (SETQ anglm (+ avec2 (- (* 2 PI) avec1))) (SETQ anglm (- avec2 avec1)) ) ;if (SETQ aro1a (+ avec1 PI (- PI (/ (- PI (ATAN 0.25)) 2))) aro2a (+ PI (- avec2 (- PI (/ (- PI (ATAN 0.25)) 2)))) ) ;setq (SETQ arpnt (POLAR avert (- avec2 (/ anglm 2)) (* 0.5 dimsc)) ;_ end of polar txpnt (POLAR avert (- avec2 (/ anglm 2)) dimsc) anglt (ANGTOS anglm 1 4) ) ;setq (COND ((< anglm PI) (SETQ angdefl (ANGTOS (- PI anglm) 1 4)) (SETQ suff_txt " RT")) ((> anglm PI) (SETQ angdefl (ANGTOS (- anglm PI) 1 4)) (SETQ suff_txt " LT")) ((= anglm 0.0000) (SETQ angdefl (ANGTOS PI 1 4))) ((= anglm PI) (SETQ angdefl (ANGTOS 0.0000 1 4))) ) ;_ end of COND (SETQ anglt (IF (EQ (STRCAT printit) "DMS") (mh_survang anglt) (STRCAT (ANGTOS (ANGTOF anglt 0) 0 2) "°") ) ;_ end of IF ) ;_ end of SETQ (SETQ deflt (STRCAT ;;; "%%225 " "< " (IF (EQ (STRCAT printit) "DMS") (mh_survang angdefl) (STRCAT (ANGTOS (ANGTOF angdefl 0) 0 2) "°") ) ;_ end of IF (IF (AND suff_txt (EQ (TYPE suff_txt) 'STR)) suff_txt "" ) ;_ end of IF ) ;_ end of STRCAT ) ;_ end of SETQ (IF (EQ (STRCASE lblordisp) "LABEL") (PROGN (IF gvpno nil (LOAD "gvpno") ) ;_ end of if (gvpno) (IF prod NIL (SETQ prod "PLAN") ) ;_ end of IF (SETQ adtentl (STRCAT "C-" prod (IF do_cmud "7MANH-ANGL" "6MANH-ANGL" ) ;_ end of IF ) ;_ end of strcat ) ;_ end of SETQ (SETQ adtent (LIST (CONS 0 "TEXT") (CONS 72 1) (CONS 73 2) (CONS 1 anglt) (CONS 8 adtentl) (CONS 50 (- 0 vwtwst)) (CONS 10 arpnt) (CONS 11 txpnt) (CONS 40 (* (/ templ 1000.0) dimsc)) ) ;list ) ;setq (SETQ mhang_ss NIL) (ENTMAKE adtent) (SETQ mhang_ss (SSADD)) (SSADD (ENTLAST) mhang_ss) (SETQ text_ent (ENTGET (ENTLAST))) (SETQ aro1l (STRCAT "C-" prod "7MANH-ANGL") ;_ end of strcat ) ;_ end of SETQ (SETQ adaent (LIST (CONS 0 "ARC") (CONS 8 aro1l) (CONS 10 avert) (CONS 40 (* 0.5 dimsc)) (CONS 50 avec1) (CONS 51 avec2) ) ;list ) ;setq (ENTMAKE adaent) (SSADD (ENTLAST) mhang_ss) (SETQ aro1 (LIST (CONS 0 "INSERT") (CONS 2 "dimaro") (CONS 8 aro1l) (CONS 10 (POLAR avert avec1 (CDR (ASSOC 40 adaent)))) (CONS 41 (* 0.110 dimsc)) (CONS 42 (* 0.110 dimsc)) (CONS 43 (* 0.110 dimsc)) (CONS 50 aro1a) ) ;list ) ;setq (ENTMAKE aro1) (SSADD (ENTLAST) mhang_ss) (SETQ aro2 (LIST (CONS 0 "INSERT") (CONS 2 "dimaro") (CONS 8 aro1l) (CONS 10 (POLAR avert avec2 (CDR (ASSOC 40 adaent)))) (CONS 41 (* 0.110 dimsc)) (CONS 42 (* 0.110 dimsc)) (CONS 43 (* 0.110 dimsc)) (CONS 50 aro2a) ) ;list ) ;setq (ENTMAKE aro2) (SSADD (ENTLAST) mhang_ss) (PRINC) (IF text_ent (COMMAND "_.move" (CDAR text_ent) "" (LIST (CADR (ASSOC 11 text_ent)) (CADDR (ASSOC 11 text_ent))) ;_ end of LIST pause ) ;_ end of command ) ;_ end of if (IF make_layer_ent NIL (LOAD "make_layer_ent" "\nFile MAKE_LAYER_ENT.LSP not loaded! ") ) ;_ end of IF (make_layer_ent (LIST (CONS 8 adtentl) (CONS 8 aro1l))) (IF makegroup NIL (LOAD "makegroup" "\nFile MAKEGROUP.LSP not loaded! ") ) ;_ end of IF (makegroup "MHANG_" mhang_ss cnt) (SETQ cnt (1+ cnt)) (SETQ mhang_ss NIL) ; (COMMAND ".layer" "c" (SUBSTR adtentl 7 1) adtentl "") ; (COMMAND ".layer" "c" (SUBSTR aro1l 7 1) aro1l "") ) ;_ end of progn (COND ((EQ (STRCASE printit) "DEGREES") (PRINC (STRCAT "\n" (ANGTOS anglm 0 4)))) ((EQ (STRCASE printit) "DMS") (PRINC (STRCAT "\n" anglt))) ) ;_ end of COND ) ;_ end of IF ;;; (IF (AND mhang_ss ;;; (EQ (TYPE mhang_ss) 'pickset) ;;; gpd-error-trap ;;; (gpd-error-trap (quote (sslength mhang_ss))) ;;; ) ;;; (PROGN ;;; (SET (READ (STRCAT "mhang_ss_" (ITOA cnt))) mhang_ss) ;;; (SETQ cnt (1+ cnt)) ;;; (SETQ mhang_ss NIL) ;;; ) ;;; ) ) ;_ end of PROGN ) ;_ end of IF ) ;_ end of while (IF makegroup NIL (LOAD "makegroup" "\nFile MAKEGROUP.LSP not loaded! ") ) ;_ end of IF (SETQ cnt 1) (WHILE (AND (EVAL (READ (STRCAT "mhang_ss_" (ITOA cnt)))) (EQ (TYPE (EVAL (READ (STRCAT "mhang_ss_" (ITOA cnt))))) 'pickset) (gpd-error-trap (QUOTE (SSLENGTH (EVAL (READ (STRCAT "mhang_ss_" (ITOA cnt))))))) ) ;_ end of AND (makegroup "MHANG_" (EVAL (READ (STRCAT "mhang_ss_" (ITOA cnt)))) cnt) (SETQ cnt (1+ cnt)) ;;; (SET (READ (STRCAT "mhang_ss_" (ITOA cnt))) NIL) ) ;_ end of WHILE (c:rslayr) (IF old_mhang_error (SETQ *error* old_mhang_error) (SETQ *error* NIL) ) ;_ end of IF (SETQ old_mhang_error NIL) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN mh_survang (inangl /) (SETQ count (STRLEN inangl) atxt inangl ) ;_ end of SETQ (WHILE (AND (NOT (= (SUBSTR atxt 1 1) "d")) (> count 0)) (SETQ atxt (SUBSTR atxt 2) count (1- count) ) ;_ end of SETQ ) ;_ end of WHILE (IF (= (SUBSTR atxt 4 1) "'") (SETQ angmin (SUBSTR atxt 2 3) secinx 5 ) ;_ end of SETQ (SETQ angmin (STRCAT "0" (SUBSTR atxt 2 2)) secinx 4 ) ;_ end of SETQ ) ;_ end of IF (IF (= (SUBSTR atxt (1+ secinx) 1) "\"") (SETQ angsec (STRCAT "0" (SUBSTR atxt secinx 2))) (SETQ angsec (SUBSTR atxt secinx 3)) ) ;_ end of IF (SETQ angl_str (STRCAT (SUBSTR inangl 1 (- (STRLEN inangl) (STRLEN atxt))) (CHR 176) ;;; "%%221" angmin angsec ) ;_ end of strcat ) ;_ end of setq ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN makedimaro () (IF (NOT (TBLSEARCH "BLOCK" "dimaro")) (PROGN (ENTMAKE '((0 . "BLOCK") (2 . "dimaro") (70 . 64) (10 0.0 0.0 0.0))) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 0.0 0.0 0.0) (11 -0.947368 0.157895 0.0) (210 0.0 0.0 1.0)) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 0.118421 0.0) (11 -0.236842 0.0 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.473684 0.0 0.0) (11 -0.947368 0.0789474 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 0.0394737 0.0) (11 -0.710526 0.0 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.710526 0.0 0.0) (11 -0.947368 -0.0394737 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 -0.0789474 0.0) (11 -0.473684 0.0 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.236842 0.0 0.0) (11 -0.947368 -0.118421 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 -0.157895 0.0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0)) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 -0.118421 0.0) (11 -0.947368 -0.0789474 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 -0.0394737 0.0) (11 -0.947368 0.0 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 0.0789474 0.0) (11 -0.947368 0.0394737 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -0.947368 0.118421 0.0) (11 -0.947368 0.157895 0.0) (210 0.0 0.0 1.0) ) ) ;_ end of entmake (ENTMAKE '((0 . "LINE") (8 . "0") (62 . 0) (10 -1.0 0.0 0.0) (11 -0.947368 0.0 0.0) (210 0.0 0.0 1.0)) ) ;_ end of entmake (ENTMAKE '((0 . "ENDBLK"))) ) ;_ end of progn ) ;_ end of if ) ;_ end of defun (PRINC) ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 0 nil nil nil T T) ;*** DO NOT add text below the comment! ***|;