Anuncios

The Autodesk Community Forums has a new look. Read more about what's changed on the Community Announcements board.

Anonymous
612 Vistas, 2 Respuestas

Bearing and Distance Lisp - Text Layers

Hi,

I have a lisp which works well for adding bearings and distances to lines. However I'm looking to make a few changes to the text and hoping someone can help me out. 

(DEFUN C:OO()
(setvar "cmdecho" 0)
(SETQ L 0 MID 0 MID 0 AN 0 BRG 0 DIST 0 A 0 B 0 C 0 D 0 MA 0 MB 0 MC 0 MD 0 MID 0 Z 0)
(PROMPT "\nSelect lines to be annotated..")
(setq ss1 (ssget)
n (sslength ss1)
index 0
dim (getvar "DIMSCALE")
ht (* dim 1.8)
)
(while (> n index)
(setq l (ssname ss1 index)
index (+ index 1)
OFFSET (* 0.6 ht)
L (ENTGET L)
ST (CDR (ASSOC 10 L))
END (CDR (ASSOC 11 L))
AN (ANGLE ST END)
BRG (CHGD(ANGTOS AN 1 4))
AN (* AN (/ 180 PI))
dAND AN
dAND (- dAND 90)
dAND (- 360 dAND))
(IF (> dAND 360)(SETQ dAND (- dAND 360)))
(IF (>= dAND 180)(SETQ dAND (+ dAND 180)))
(IF (= dAND 540)(SETQ dAND 0))
(SETQ DIST (RTOS (DISTANCE ST END) 2 3)
A (CAR ST)
B (CDR ST)
B (CAR B)
C (CAR END)
D (CDR END)
D (CAR D)
MA (+ A C)
MB (+ B D)
MC (/ MA 2)
MD (/ MB 2)
ANR (* (* (/ AN 360) 2) PI)
MID (LIST MC MD))
(IF (> dAND 180)(SETQ MID1 (POLAR MID (- ANR (* 0.5 PI)) OFFSET)))
(IF (> dAND 180)(SETQ MID2 (POLAR MID (+ ANR (* 0.5 PI)) (+ OFFSET HT))))
(IF (<= dAND 180)(SETQ MID1 (POLAR MID (+ ANR (* 0.5 PI)) OFFSET)))
(IF (<= dAND 180)(SETQ MID2 (POLAR MID (- ANR (* 0.5 PI)) (+ OFFSET HT))))
(SETQ Z (+ Z 1))
(IF (= Z 1)(COMMAND "STYLE" "rjc" "rjc" HT "1.00" "" "" "" ""))
(COMMAND "TEXT" "C" MID1 dAND BRG)

(COMMAND "TEXT" "C" MID2 dAND DIST)
(command "osnap" "end")
))

 

I'm happy the text style, height and offset to line.

But I'd like the distance to be..

On Layer - DISTANCE

Color - RED

Oblique - 70d

 

and for the bearing..

On Layer - BEARING

Color - WHITE

 

Thanks in advance,

Ross