Replace character in string

[Clever_Elf]

G'day everyone.

 

I have rolled back to this version because things went weird after that. 

I'm still looking to round to 5"

This will affect the minutes if seconds are 55 or above.

Any ideas?

(defun c:bd ( / ang ber dis mid pt1 pt2 scl )
    (initget 6)
    (if (setq scl (getreal  "\nSpecify drawing scale: "))
        (while
            (and
                (setq pt1 (getpoint "\nSpecify 1st point <exit>: "))
                (setq pt2 (getpoint "\nSpecify 2nd point <exit>: " pt1))
            )
            (setq ang (angle pt1 pt2)
                  dis (* scl 0.001 (distance pt1 pt2))
                  mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "DIM")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
	           '(051 . 0.349006763285)
                    (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) -2.5))
                    (cons 050 ang)
                    (cons 001 (vl-string-translate "." "|" (rtos dis 2 3)))
                )
            )
            (setq ber (angtos ang)
                  ber (vl-string-subst "%%d"   "d"  ber)
                  ber (vl-string-subst "%%135" "'"  ber)
                  ber (vl-string-subst "%%136" "\"" ber)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "BEAR")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
                    (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 050 ang)
                    (cons 001 ber)
                )
            )
        )
    )
    (princ)
)

 

[BIGAL]

I think best idea is go back the to post I made earlier and pull apart Bearing into degs, mins, secs then can look at the secs if its between 55.00000001 and 59.999999999 then make it 0 or dont add to string and add 1 to mins.

 

1.167r = 66°52'25"

Edited August 22, 2023 by BIGAL

[Lee Mac]

Rather than manipulating the string returned by angtos and thereby needing to account for when values greater than 55" are rounded up to the next 0'00", it's likely easier to round the radian value prior to formatting, e.g.:

 

(defun c:bd ( / ang ber dis mid pt1 pt2 scl )
    (initget 6)
    (if (setq scl (getreal  "\nSpecify drawing scale: "))
        (while
            (and
                (setq pt1 (getpoint "\nSpecify 1st point <exit>: "))
                (setq pt2 (getpoint "\nSpecify 2nd point <exit>: " pt1))
            )
            (setq ang (angle pt1 pt2)
                  dis (* scl 0.001 (distance pt1 pt2))
                  mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "DIM")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
                    (cons 051 (* pi (/ 20.0 180.0)))
                    (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) -2.5))
                    (cons 050 ang)
                    (cons 001 (vl-string-translate "." "|" (rtos dis 2 3)))
                )
            )
            (setq ber (angtos (roundm ang (* pi (/ 5.0 3600.0 180.0))))
                  ber (vl-string-subst "%%d"   "d"  ber)
                  ber (vl-string-subst "%%135" "'"  ber)
                  ber (vl-string-subst "%%136" "\"" ber)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "BEAR")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
                    (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 050 ang)
                    (cons 001 ber)
                )
            )
        )
    )
    (princ)
)
(defun roundm ( x m ) (* m (atof (rtos (/ x (float m)) 2 0))))
(princ)

 

Edited August 22, 2023 by Lee Mac

[Clever_Elf]

This is almost working perfectly.

The whole reason for this project is i have another lisp that allows me to select the labeled bearing and distances and it the exports these to a text file. This text file gets pasted into a spread sheet which produces a report on the closed figure. (It's survey QA thing)

The spread sheet falls over if it receives single digits for minutes and seconds. At the moment we have for example 180°0'0"

The spread sheet requires 180°00'00". So if the minutes and seconds are smaller than 10 we need to pad with a leading 0. 

180°5'5" needs to be 180°05'05" for example. I assume we need to break the string up and decide if it needs a prefix 0 or not and apply accordingly. I hope that made sense. This a soooo close. Once again thanks for everyone's input.

[lastknownuser]

Here is my version, maybe it will do what you need if I understood correctly

 

(defun c:bd ( / )
(setq oldosmode (getvar "osmode"))
(setq scale (getreal "\nEnter the drawing scale: ")) 
(setq pt1 (getpoint "\nEnter the first point: "))
(setq pt2 (getpoint "\nEnter the second point: "))
(setvar "osmode" 0 )
(setq dis (distance pt1 pt2))
(setq scalefactor(/ scale 1000))
(setq scaled-distance(* dis scalefactor))
(setq BearRad (angle pt1 pt2))
(setq pt3 (polar pt1 BearRad (/ dis 2.0)))
(setq pt4 (list (+ (car pt3) 0) (+ (cadr pt3) (* 1 scale))))
(setq pt5 (list (+ (car pt3) 0) (+ (cadr pt3) (* 4 scale))))
(setq distance-final (rtos scaled-distance 2 3))
(setq bearing (angtos BearRad 1 4))
(setq bearingROT bearing)

(setq newdeg "°"); <--- deg symbol
(setq newmin "´"); <--- min symbol
(setq newsec "˝"); <--- sec symbol
(setq newdis "|"); <--- dist symbol

(setq distance-final (replace newdis "." distance-final))
(setq bearing (replace newdeg "d" bearing))
(setq bearing (replace newmin "'" bearing))
(setq bearing (replace newsec "\"" bearing))

(setq testmin (nth 0 (LM:str->lst (nth 1 (LM:str->lst bearing newdeg)) newmin)))
(if (= (strlen testmin) 1)
  (setq bearing (strcat (nth 0 (LM:str->lst bearing newdeg))
			newdeg
			"0"
			testmin
			newmin
			(nth 1 (LM:str->lst (nth 1 (LM:str->lst bearing newdeg)) newmin))
			);strcat
	);setq
  );if

(setq testsec (nth 0 (LM:str->lst (nth 1 (LM:str->lst (nth 1 (LM:str->lst bearing newdeg)) newmin)) newsec)))
(if (= (strlen testsec) 1)
  (setq bearing (strcat (nth 0 (LM:str->lst bearing newdeg))
			newdeg
			(nth 0 (LM:str->lst (nth 1 (LM:str->lst bearing newdeg)) newmin))
			newmin
			"0"
			(nth 1 (LM:str->lst (nth 1 (LM:str->lst bearing newdeg)) newmin))
			);strcat
	);setq
  );if

(command "._CLAYER" "DIM")
(setvar 'CELTYPE "ByLayer")
(setvar 'CECOLOR "ByLayer")
(setvar 'textsize 2)
;(setvar 'textstyle "SS")  
(command "text" "j" "c" pt4 "2" 0 distance-final)
(command "rotate" "last" "" pt3 bearingROT)

(command "._CLAYER" "BEAR")
(setvar 'CELTYPE "ByLayer")
(setvar 'CECOLOR "ByLayer")
(setvar 'textsize 2)
;(setvar 'textstyle "SU")  
(command "text" "j" "c" pt5 "2" 0 bearing)
(command "rotate" "last" "" pt3 bearingROT)

(setvar "osmode" oldosmode)  
);defun

(defun replace  (new old string / pos)
 (while (setq pos (vl-string-search old string pos))
   (setq string (vl-string-subst new old string pos)
         pos    (+ pos (strlen new))
	 );setq
   );while
  string
  );defun

(defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
        (setq lst (cons (substr str 1 pos) lst)
              str (substr str (+ pos len))
        )
    )
    (reverse (cons str lst))
)

 

[Clever_Elf]

Thankyou lastknownuser. 

I can enter scale and select 2 points but that's as far as it gets 

[lastknownuser]

8 hours ago, Clever_Elf said:

Thankyou lastknownuser. 

I can enter scale and select 2 points but that's as far as it gets 

Did you load the functions "replace" and "LM:str->lst"? Maybe thats why, it works for me. Also edit the characters that need to be replaced, maybe its that (marked with <---). And you can check command bar to see error message. It does need a little more work with scaling thing, but as I said its working for me when I run it.

[BIGAL]

In add on civil software it has these rules already applied, you nominate what the rounding factor is to be so when doing labelling it does it automatically, plus way more, but if wanting one routine then again look at breaking down the angle Lee's idea is a good one looking at rounding at fractions.

[Lee Mac]

Here's another way to pad with leading zeroes using some mapcar trickery -

(defun c:bd ( / ang ber dis lst mid pt1 pt2 scl )
    (initget 6)
    (if (setq scl (getreal  "\nSpecify drawing scale: "))
        (while
            (and
                (setq pt1 (getpoint "\nSpecify 1st point <exit>: "))
                (setq pt2 (getpoint "\nSpecify 2nd point <exit>: " pt1))
            )
            (setq ang (angle pt1 pt2)
                  dis (* scl 0.001 (distance pt1 pt2))
                  mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "DIM")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
                    (cons 051 (* pi (/ 20.0 180.0)))
                    (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) -2.5))
                    (cons 050 ang)
                    (cons 001 (vl-string-translate "." "|" (rtos dis 2 3)))
                )
            )
            (setq ber
                (vl-list->string
                    (apply 'append
                        (mapcar
                           '(lambda ( a b c )
                                (cond
                                    (   (and (= 100 a) (< 47 b 58) (not (< 47 c 58)))
                                       '(100 048)
                                    )
                                    (   (and (= 039 a) (< 47 b 58) (not (< 47 c 58)))
                                       '(039 048)
                                    )
                                    (   (list a)   )
                                )
                            )
                            (setq lst (vl-string->list (angtos (roundm ang (* pi (/ 5.0 3600.0 180.0))) 1 3)))
                            (append (cdr  lst) '(nil))
                            (append (cddr lst) '(nil nil))
                        )
                    )
                )
                ber (vl-string-subst "%%d"   "d"  ber)
                ber (vl-string-subst "%%135" "'"  ber)
                ber (vl-string-subst "%%136" "\"" ber)
            )
            (entmake
                (list
                   '(000 . "TEXT")
                   '(008 . "BEAR")
                   '(062 . 256)
                   '(006 . "BYLAYER")
                   '(040 . 2.0)
                   '(072 . 1)
                   '(073 . 2)
                    (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle)))
                    (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5))
                    (cons 050 ang)
                    (cons 001 ber)
                )
            )
        )
    )
    (princ)
)
(defun roundm ( x m ) (* m (atof (rtos (/ x (float m)) 2 0))))
(princ)

 

[Clever_Elf]

Thanks everyone for your input.

The latest version works perfectly. Thank you, Lee Mac.

When i get time will be asking some questions about how the above works.

I'm off on holidays for now.

Thanks again everyone