I snagged the following bearings.lsp I love this routine! However, I work in architectual vs. engineering. So when it gives me the distance it will say 780' instead of 65'. How do I get it to divide the length by 12...or give the true length?
Also, when I complete the routine, it wipes out all my osnaps. Can that be fixed?
If you couldn't guess....I don't know much about code. :)
Thanks in advance!
oh...and I tried to attached the .lsp but it wouldn't let me for some reason so I just copied it in.
Code:
; o Command: (load "BEARINGS") BEARINGS
; o Automatically Annotates all lines, in a window or crossing selection set,
; with SURVEYOR style BEARINGS and DISTANCES, in user specified format.
; o Removes non-line entities from selection set before annotating
; selected line entities.
; o Left-Right Orientation of text placement is determined by the direction
; the LINE ENTITY was entered. CLOCKWISE line orientation is assumed for
; L and R KEYWORDS.
; o Surveyor Angles have a real degree mark. Distances have a foot mark to
; represent decimal feet.
; o Adjusts text placement based on TEXTSIZE.
; o Adjusts NW and SE text orientation for better readability of the
; Bearing-Distance dimension.
; o User specified Bearing Direction reversal.
; o Resets current STYLE HT to 0.0
; o KEYWORDS used to select desired insertion format are:
;
; LR - BEARING/DIST Left/Right
; RL - BEARING/DIST Right/Left
; LL - BEARING-DIST Left
; RR - BEARING-DIST Right
; BL - BEARING Left
; BR - BEARING Right
; DL - DIST Left
; DR - DIST Right
;
(DEFUN CHGD(OS / NS SL CT LT )
(SETQ NS "" SL (STRLEN OS) CT 1)
(WHILE (<= CT SL)
(SETQ LT (SUBSTR OS CT 1))
(IF (= LT "d")(SETQ LT "%%d"))
(SETQ CT (1+ CT) NS (STRCAT NS LT))))
(DEFUN C:BEARINGS( / P1 P2 P3 P4 DSTR DIST ASTR ANG TMP ENT LEN SS FLG KW1 TH KW )
(SETVAR "OSMODE" 0)
(SETVAR "ANGBASE" 0)
(SETVAR "CMDECHO" 0)
(command "style" "" "" 0.0 "" "" "" "" "" nil)
(PRINC "Note: ALL DISTANCES are from the X-Y PLANE\n")
(INITGET 1 "LR RL LL RR BL BR DL DR")
(SETQ KW (GETKWORD "LR RL LL RR BL BR DL DR: "))
(initget (+ 2 4))
(SETQ TH (GETDIST (strcat "TEXT HEIGHT <" (rtos (getvar "TEXTSIZE")) "> :")))
(if (= nil TH)(setq th (getvar "textsize")))
(INITGET 1 "Yes No")
(SETQ KW1 (GETKWORD "Reverse the Bearing Direction <Y>es <N>o: "))
(SETQ FLG 0)
(if (= KW1 "Yes")(progn
(IF (and(= KW "LR")(= FLG 0))(SETQ KW "RL" FLG 1))
(IF (and(= KW "RL")(= FLG 0))(SETQ KW "LR" FLG 1))
(IF (and(= KW "LL")(= FLG 0))(SETQ KW "RR" FLG 1))
(IF (and(= KW "RR")(= FLG 0))(SETQ KW "LL" FLG 1))
(IF (and(= KW "BL")(= FLG 0))(SETQ KW "BR" FLG 1))
(IF (and(= KW "BR")(= FLG 0))(SETQ KW "BL" FLG 1))
(IF (and(= KW "DL")(= FLG 0))(SETQ KW "DR" FLG 1))
(IF (and(= KW "DR")(= FLG 0))(SETQ KW "DL" FLG 1))
))
(SETVAR "TEXTSIZE" TH)
(SETQ SS (SSGET))
(SETQ LEN (SSLENGTH SS))
(SETVAR "HIGHLIGHT" 0)
(PRINC "WORKING...\n")
(REPEAT LEN
(SETQ LEN (1- LEN))
(SETQ ENT (SSNAME SS LEN))
(IF (/= "LINE" (CDR (ASSOC '0 (ENTGET ENT))))
(SSDEL ENT SS))
)
(SETQ LEN (SSLENGTH SS))
(REPEAT LEN
(SETQ LEN (1- LEN)
ENT (ENTGET (SSNAME SS LEN))
P1 (CDR (ASSOC '10 ENT))
P2 (CDR (ASSOC '11 ENT))
)
(IF (= KW1 "Yes")(SETQ TMP P2 P2 P1 P1 TMP))
(SETQ ANG (ANGLE P1 P2)
ASTR (CHGD (ANGTOS ANG 4 6))
DIST (DISTANCE P1 P2)
DSTR (RTOS DIST 2 2)
DSTR (STRCAT DSTR "\047")
P3 (POLAR P1 ANG (/ DIST 2.0))
P3 (POLAR P3 (+ ANG (/ PI 2.0))(* TH 1.125))
P4 (POLAR P1 ANG (/ DIST 2.0))
P4 (POLAR P4 (- ANG (/ PI 2.0))(* TH 1.125))
)
(IF (AND (> ANG (/ PI 2.0))(< ANG (* PI 1.5)))(SETQ ANG (- ANG PI)))
(SETQ ANG (ANGTOS ANG 0 8))
(IF (OR (= KW "DL") (= KW "DR"))(SETQ ASTR ""))
(IF (OR (= KW "BL")(= KW "BR"))(SETQ DSTR ""))
(IF (= ASTR "E")(SETQ ASTR "East"))
(IF (= ASTR "N")(SETQ ASTR "North"))
(IF (= ASTR "W")(SETQ ASTR "West"))
(IF (= ASTR "S")(SETQ ASTR "South"))
(IF (OR (= KW "LR")(= KW "BL")(= KW "DR"))(PROGN
(COMMAND "TEXT" "M" P3 "" ANG ASTR)
(COMMAND "TEXT" "M" P4 "" ANG DSTR)
)
)
(IF (= KW "LL") (PROGN
(SETQ ASTR (STRCAT ASTR " " DSTR))
(COMMAND "TEXT" "M" P3 "" ANG ASTR)
)
)
(IF (OR (= KW "RL")(= KW "BR")(= KW "DL")) (PROGN
(COMMAND "TEXT" "M" P4 "" ANG ASTR)
(COMMAND "TEXT" "M" P3 "" ANG DSTR)
)
)
(IF (= KW "RR") (PROGN
(SETQ ASTR (STRCAT ASTR " " DSTR))
(COMMAND "TEXT" "M" P4 "" ANG ASTR)
)
)
)
(SETVAR "HIGHLIGHT" 1)
(SETQ SS nil)(GC)
(SETVAR "FLATLAND" 0)
(PRINC "DONE")
(PRINC)
)
Re: Surveying Bearing/Distance LISP Routine
Posting Permissions
Reply With Quote