- Marcar como nuevo
- Favorito
- Suscribir
- Silenciar
- Suscribirse a un feed RSS
- Resaltar
- Imprimir
- Denunciar
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
¡Resuelto! Ir a solución.
- Marcar como nuevo
- Favorito
- Suscribir
- Silenciar
- Suscribirse a un feed RSS
- Resaltar
- Imprimir
- Denunciar
@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
- Marcar como nuevo
- Favorito
- Suscribir
- Silenciar
- Suscribirse a un feed RSS
- Resaltar
- Imprimir
- Denunciar
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