;;;Place a fixed radius DMS angle dim. (w/o DIM). Fills in leading zeros. ;;; ;;; ;;; ;;; ;;; Separated "Label/Display" and format prompts , added option to label in degrees. ;;; ;;;> Author: Henry C. Francis ;;;> 425 N. Ashe St. ;;;> Southern Pines, NC 28387 ;;;> http://paracadd.com ;;;> All rights reserved. ;;; ;;;> COPYRIGHT: 5-28-96 ;;;> EDITED: 01-06-2006 ;;; (DEFUN c:mhang (/) (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! ")) (SETQ lblordisp (ukword 1 "Label Display" "Do you want to abel the angle or just isplay it?" (IF lblordisp lblordisp "Label"))) (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) (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 (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)) ) ;cond ) ;if (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)"°") ) ) (SETQ deflt (STRCAT ;;; "%%225 " "< " (IF (EQ (STRCAT printit) "DMS") (mh_survang angdefl) (STRCAT(ANGTOS(ANGTOF angdefl 0)0 2)"°") ) suff_txt ) ;_ end of STRCAT ) ;_ end of SETQ (IF (EQ (STRCASE lblordisp) "LABEL") (PROGN (IF gvpno nil (LOAD "gvpno") ) ;_ end of if (gvpno) (SETQ adtentl (STRCAT "C-" prod (IF do_cmud "7DIMS" "6DIMS" ) ;_ 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 (ENTMAKE adtent) (SETQ text_ent (ENTGET (ENTLAST))) (SETQ aro1l (STRCAT "C-" prod "7DIMS") ;_ 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) (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) (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) (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 (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 ) ;_ end of while (c:rslayr) ) ;_ 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! ***|;