Jump to content

Replace character in string

Clever_Elf

By Clever_Elf
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Clever_Elf Rookie

Clever_Elf

Posted
  • Author
Posted

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)
)

 

  • Replies 29
  • Created
  • Last Reply

Top Posters In This Topic

  • Clever_Elf

    12

  • BIGAL

    4

  • Lee Mac

    4

  • exceed

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhupp
mhupp

Think this should do it   (defun AT:NumFix (s n) ;; Fix number string with leading zeros ;; s - Number string to fix ;; n - Number of characters for final string ;; Alan J. Thompson, 10.29

Lee Mac
Lee Mac

Consider the following code - (defun c:bd ( / ang ber dis mid pt1 pt2 scl ) (initget 6) (if (and (setq scl (getreal "\nSpecify drawing scale: ")) (setq pt1

Lee Mac
Lee Mac

You're most welcome, I'm glad it helps.     Those are DXF group code (I simply pad them to 3 digits to please my OCD) - here is a DXF reference. Navigate to ENTITIES and then rev

Posted Images

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
Lee Mac Grand Master

Lee Mac

Posted
Posted (edited)

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 by Lee Mac
Clever_Elf Rookie

Clever_Elf

Posted
  • Author
Posted

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 Collaborator

lastknownuser

Posted
Posted

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 Rookie

Clever_Elf

Posted
  • Author
Posted

Thankyou lastknownuser. 

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

lastknownuser Collaborator

lastknownuser

Posted
Posted
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 Grand Master

BIGAL

Posted
Posted

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 Grand Master

Lee Mac

Posted
Posted

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 Rookie

Clever_Elf

Posted
  • Author
Posted

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 😀

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...