Bearing and Distance Lisp - Text Layers

[Anonymous]

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

[Moshe-A · Accepted solution]

@Anonymous  hi,

here is my fix, untested cause you did not send all the code. there is a (CHGD) function missing.

about Oblique - 70d?  you meant only 15d - yes?!

enjoy

moshe

(defun create_layer (name clr)
 (if (null (tblsearch "layer" name))
  (command "layer" "new" name "color" clr name "")
 )
); change layer

(DEFUN C:OO ()
 (setvar "cmdecho" 0)
 (command "undo" "begin")
  
 (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)
  ); setq
   
  (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)
  ); setq
   
  (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)
  (create_layer "bearing" 7) 
  (command "chprop" "si" "last" "layer" "bearing" "")
  
  (COMMAND "TEXT" "C" MID2 dAND DIST)
  (setq elist (entget (entlast)))
  (entmod (subst (cons '51 (/ pi -12)) (assoc '51 elist) elist))
   
  (create_layer "distance" 1) 
  (command "chprop" "si" "last" "layer" "distance" "")
 ); while
  
 (command "undo" "end")
 (setvar "cmdecho" 1)
  
 (princ) 
); c:oo

[Anonymous]

Thanks  Moshe-A. That worked really well.

I've added the CHGD function that I'd missed on the previous post.

For the oblique text I meant 20d (sloping to the right) not 70d! I made the change to lisp and it's working as I hoped.

I really appreciate you taking the time to help me with this.

Thanks 🙂

Ross

Below is the working lisp

(defun CHGD(os / ns sl ct lt)
(setq ns "" sl (strlen os) ct 1)
(command "osnap" "none")
(while (<= ct sl)
(setq lt (substr os ct 1))
(if (= lt "d")(setq lt "%%d"))
(setq ct (1+ ct) ns (strcat ns lt)))
)
(defun create_layer (name clr)
(if (null (tblsearch "layer" name))
(command "layer" "new" name "color" clr name "")
)
); change layer

(DEFUN C:OO ()
(setvar "cmdecho" 0)
(command "undo" "begin")

(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)
); setq

(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)
); setq

(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)
(create_layer "bearing" 7)
(command "chprop" "si" "last" "layer" "bearing" "")

(COMMAND "TEXT" "C" MID2 dAND DIST)
(setq elist (entget (entlast)))
(entmod (subst (cons '51 (/ pi 9)) (assoc '51 elist) elist))

(create_layer "distance" 1)
(command "chprop" "si" "last" "layer" "distance" "")
); while

(command "undo" "end")
(setvar "cmdecho" 1)

(princ)
); c:oo