Jump to content

Enter Dimension (MM) in plain text and convert to FT. Thanks in advance.


tmelancon

Recommended Posts

After we finish drawing/converting a piping sketch, we run c:dtext and enter rounded dimensions (i.e. if its 13'-6" we enter 14') along the pipe to give our technicians an ideas of how long certain pipe spans our before performing their inspections. When dealing with imperial that's easy no problem.

 

However, sometimes in CAD we are working with construction drawings in MM and we have to convert those dimensions to FT. I simply created a printable chart that allows our users to quickly glance at and see the MM range so they can enter the dimension in FT. (i.e. 1219-1523mm we would type 4' for that run). This works but I figured I could take it up a notch and help my guys enter these dimensions programmatically.

 

I have something written and I have to give Tharwat credit for his piece of code that allowed me to write what I needed to atleast get me started. Thank you so much!!

 

What I have now works flawlessly, the only problem is I wish I could alter the code so that It rounds up and doesn't add the inches. I just want rounded whole numbers in feet (i.e. 13'-6" to 14', 18'-2" to 18'). Here is the code I have been working on:

 

(defun c:mm2in (/ in ss)
 ;; ==================================================    ;;
 ;;    Author : Tharwat Al Shoufi .Date: 22.Nov.2014    ;;
 ;;    Converts Text Strings from Millimeter to Inch    ;;
 ;; ==================================================    ;;
 (if (setq in (/ 1. 25.4)
           ss (ssget "_:L"
                     '((0 . "TEXT,MTEXT")
                       (1 . "1*,2*,3*,4*,5*,6*,7*,8*,9*,x*,X*")
                      )
              )
     )
   ((lambda (x / sn e s a)
      (while (setq sn (ssname ss (setq x (1+ x))))
        (entmod
          (subst
            (cons
              1
              (if (wcmatch
                    (setq
                      a (strcase
                          (substr
                            (setq
                              s (cdr (assoc 1 (setq e (entget sn))))
                            )
                            1
                            1
                          )
                        )
                    )
                    "X*"
                  )
                (if (/= (atof (substr s 2)) 0.)
                  (strcat a (rtos (* (atof (substr s 2)) in) 4 0))
                  s
                )
                (rtos (* (atof s) in) 4 0)
              )
            )
            (assoc 1 e)
            e
          )
        )
      )
    )
     -1
   )
 )
 (princ)
)

 ;; ==================================================    ;;
 ;;    Author : T.Melancon Date: 27Jun2017    ;;
 ;;    Allows user to enter MM in plain text then converts to FT               ;;
 ;;    Loops so user can enter multiple dimensions                                  ;;
 ;; ==================================================    ;;

(defun c:dimm()
(setq oldlayr (getvar "clayer"))
(setq t_size 0.08)
(COMMAND "LAYER" "S" "DIM" "")
(WHILE
(SETQ POINT (GETPOINT "\nSpecify Point For Text Insertion..."))
(SETQ DIMS (GETSTRING "\nEnter Dimensions In MM: "))
(command "._text" "L" POINT t_size "0" DIMS)
(sssetfirst nil (ssget "L"))
(C:MM2IN)
)
(SETVAR "CLAYER" OLDLAYR)
(PRINC))

Link to comment
Share on other sites

If you take mm and divide by 304.8 you get decimal feet so round the answer 4419 = 14.5 feet and you want 15'

 

Just search here for "round" there are some examples.

Link to comment
Share on other sites

BigAL, thanks for your reply. I have been diligently searching for "round" code and examples. I will not stop until I get something. I wish I better understood the different evaluations and expressions. I would be able to interpret more advance code quicker. I will get there. For now I found this, which I think is something that I am looking for, I am just struggling to know where to even begin to make adjustments and put it in my existing code. If you wish to help out a little or a lot I will leave that up to you. I do not wish to come here and demand anything from anybody. I am willing to put the work in. Ill keep trying and see where I get. In the meantime check out what I found below..

 

The_Caddie wrote:

 

Anything below x.5 (example 10.342) should round down to the nearest and anything above x.5 should (example 67.567round up. As for items that fall exactly on x.5 (example 2978.5) they should round down also

 

Quick fix

(if (eq (rem num (fix num)) 0.5) (fix num)
(fix (+ num
         (/ num (abs num) 2.0)
      )
        )
 )

Link to comment
Share on other sites

I got it. I went back to the basics and executed it from the ground up and kept it as basic as possible. If you guys have any input that would be great.

 

Also, if anyone wants to chime in before I get it figured out, I am noticing that anything 304mm and less it shows 0' as result. I want to make anything less than 304mm to show up as

 

Here is what I have that works for me:

 

(defun c:dimm (/ oldlayr t_size point dims DFT DIMSFT)
 (setq oldlayr (getvar "clayer"))
 (setq t_size 0.08)
 (COMMAND "LAYER" "S" "DIM" "")
 (WHILE
   (SETQ POINT (GETPOINT "\nSpecify Point For Dimension Insertion..."))
    (SETQ DIMS (GETSTRING "\nEnter Dimensions In MM: "))
    (SETQ DFT (ATOF DIMS))
    (SETQ DIMSFT (STRCAT (RTOS (FIX (/ DFT 304.) 2 0) "'"))
    (command "._text" "MC" POINT t_size "0" DIMSFT)
 )
 (SETVAR "CLAYER" OLDLAYR)
 (PRINC)
)

Link to comment
Share on other sites

I was able to figure it out. Just thought I would share with you guys. Any suggestions on making it better would be entertained. Always looking at different approaches. Thanks BIGAL for your input!

 

(defun c:dimm (/ *ERROR* oldlayr t_size point dims DFT DIMSFT)
(setvar "cmdecho" 0)
 (defun *error* (msg)
   (if    oldlayr
     (setvar "clayer" oldlayr)
   )
 )
 (setq oldlayr (getvar "clayer"))
 (setq t_size 0.08)
 (COMMAND "LAYER" "S" "DIM" "")
 (WHILE
   (SETQ POINT (GETPOINT "\nSpecify Point For Dimension Insertion..."))
    (SETQ DIMS (GETSTRING "\nEnter Dimensions In MM: "))
    (SETQ DFT (ATOF DIMS))
    (COND ((< DFT 303)
       (SETQ DIMSFT "<1'")
       (command "._text" "MC" POINT t_size "0" DIMSFT)
      )
      ((> DFT 303)
       (SETQ DIMSFT (STRCAT (RTOS (FIX (/ DFT 304.) 2 0) "'"))
       (command "._text" "MC" POINT t_size "0" DIMSFT)
      )
    )
 )
 (SETVAR "CLAYER" OLDLAYR)
 (PRINC)
)

Link to comment
Share on other sites

I was able to figure it out. Just thought I would share with you guys. Any suggestions on making it better would be entertained. Always looking at different approaches. Thanks BIGAL for your input!

 

(defun c:dimm (/ *ERROR* oldlayr t_size point dims DFT DIMSFT)
(setvar "cmdecho" 0)
 (defun *error* (msg)
   (if    oldlayr
     (setvar "clayer" oldlayr)
   )
 )
 (setq oldlayr (getvar "clayer"))
 (setq t_size 0.08)
 (COMMAND "LAYER" "S" "DIM" "")
 (WHILE
   (SETQ POINT (GETPOINT "\nSpecify Point For Dimension Insertion..."))
    (SETQ DIMS (GETSTRING "\nEnter Dimensions In MM: "))
    (SETQ DFT (ATOF DIMS))
    (COND ((< DFT 303)
       (SETQ DIMSFT "<1'")
       (command "._text" "MC" POINT t_size "0" DIMSFT)
      )
      ((> DFT 303)
       (SETQ DIMSFT (STRCAT (RTOS (FIX (/ DFT 304.) 2 0) "'"))
       (command "._text" "MC" POINT t_size "0" DIMSFT)
      )
    )
 )
 (SETVAR "CLAYER" OLDLAYR)
 (PRINC)
)

 

One thing that stands out is the layer "S" will error if the layer does not exist .. perhaps:

(command "LAYER"
   (if (tblobjname "layer" "DIM")
     "S"
     "M"
   )
   "DIM"
   ""
 )

Link to comment
Share on other sites

Good catch ronjonp, I was so excited about getting it coded I forgot about the what-if scenarios. Anyways I also added - setting the color to blue to DIMS layer if it didnt exist. That completes the layer creation properly on my end. Cheers.

 

(command "LAYER"
      (if (tblobjname "layer" "DIM")
        "S"
        "M"
      )
      "DIM"
      [color=red]"C"
      "5"
      "DIM"[/color]
      ""
 )

Link to comment
Share on other sites

  • 2 weeks later...

Been messing around the forums reading different things, updated the code a little bit more. If anyone has anything they would mod to make it better I am all ears:

 

(defun c:dimm (/ *ERROR* oldlayr dims DFT DIMSFT ent)
(setvar "cmdecho" 0)
 (defun *error* (msg)
   (if    oldlayr
     (setvar "clayer" oldlayr)
   )
 )
 (setq oldlayr (getvar "clayer"))
 (command "LAYER"
      (if (tblobjname "layer" "DIM")
        "S"
        "M"
      )
      "DIM"
          "C"
          "5"
          "DIM"
          ""
 )
 (WHILE
    (SETQ DIMS (GETSTRING "\nEnter Dimensions In MM: "))
    (SETQ DFT (ATOF DIMS))
    (COND ((< DFT 303)
       (SETQ DIMSFT "<1'")
              (setq ent (entmakex
              (list '(0 . "TEXT")
                (cons 10 '(0 0 0))
                            (cons 40 0.08)
                            (cons 7 (getvar "TEXTSTYLE"))
                            (cons 1 DIMSFT))))
            (command "_cutclip" ent "" "_pasteclip" pause)
      )
      ((> DFT 303)
       (SETQ DIMSFT (STRCAT (RTOS (FIX (/ DFT 304.) 2 0) "'"))
              (setq ent (entmakex
              (list '(0 . "TEXT")
                (cons 10 '(0 0 0))
                            (cons 40 0.08)
                            (cons 7 (getvar "TEXTSTYLE"))
                            (cons 1 DIMSFT))))
            (command "_cutclip" ent "" "_pasteclip" pause) 
      )
    )
 )
 (SETVAR "CLAYER" OLDLAYR)
 (PRINC)
)

Link to comment
Share on other sites

Glad you added the less than 304 etc fixed that problem.

 

A little suggestion make a library defun that checks for a layer then can use in any code rather only 1 line required, (laychk layername colour linetype)

Link to comment
Share on other sites

Hey BigAl thanks so much! Its great hearing feedback! Im at the house on my phone but put something together quickly. Are you talking about something like this?

 

If so I will add it Monday at the office. Thanks again man!

 

(defun laychk (lname col)
(if (not col) 
    (setq col "5"))
(if (not (tblsearch "layer" lname)) 
    (command "layer" "n" lname "c" col lname "")) 
(princ))

 

 

Example:

(laychk "DIM" "5")

Link to comment
Share on other sites

Ok so I refined the code more and I think it works excellent. My guys are loving it and for those on the forums who are using it and love it I hope it does well for what you need it for. I am now using GRREAD on the text insertion.

 

I just cannot figure out how and where to edit the code so that when a user does enter MM but then wants to exit out of command instead of placing the FT, it erases the entry. At the moment it just drops the entry in CAD wherever the cursor is at. Have a look, please chime in if you can add value. Thanks and God bless.

 

(defun c:dimm (/ *error* oldlayr oldorth dims DFT DIMSFT ent)
 (setvar "cmdecho" 0)
 (setq oldlayr (getvar "clayer"))
 (setq oldorth (getvar "orthomode"))
 (defun *error* (MSG)
   (if    oldlayr
     (setvar "clayer" oldlayr)
   )
   (if    oldorth
     (setvar "orthomode" oldorth)
   )
   [color=red](and ENT (entdel ENT))[/color]
   (if    msg
     (prompt msg)
   )
   ;(ENTDEL ENT)
 )
 (laychk_s "DIM" "5" "CONTINUOUS")
 (WHILE
   (SETQ DIMS (GETSTRING "\nEnter Pipe Length In MM: "))
    (SETQ DFT (ATOF DIMS))
    (COND ((AND (< DFT 303) (> DFT 1))
       (SETQ DIMSFT "<1'")
       (SETQ ENT (Entmakex
           (list '(0 . "TEXT")
                 (cons 10 '(-0.25 -0.25 0))
                 (cons 40 0.08)
                 (cons 7 (getvar "TEXTSTYLE"))
                 (cons 1 DIMSFT)
           )
             )
       )
       (SETVAR "ORTHOMODE" 0)
       (princ "\nPlace Your Pipe Length: ")
       (While
         (Eq (car (setq pt (grread t 15 0))) 5)
          (Redraw)
          (Entmod (subst (cons 10 (cadr pt))
                 (assoc 10 (entget ENT))
                 (entget ENT)
              )
          )
       );END WHILE
      );END FIRST COND STATEMENT
      ((> DFT 303)
       (SETQ DIMSFT (STRCAT (RTOS (FIX (/ DFT 304.) 2 0) "'"))
       (SETQ ENT (Entmakex
           (list '(0 . "TEXT")
                 (cons 10 '(-0.25 -0.25 0))
                 (cons 40 0.08)
                 (cons 7 (getvar "TEXTSTYLE"))
                 (cons 1 DIMSFT)
           )
             )
       )
       (SETVAR "ORTHOMODE" 0)
       (princ "\nPlace Your Pipe Length: ")
       (While
         (Eq (car (setq pt (grread t 15 0))) 5)
          (Redraw)
          (Entmod (subst (cons 10 (cadr pt))
                 (assoc 10 (entget ENT))
                 (entget ENT)
              )
          )
       );END WHILE
      );END SECOND COND STATEMENT
    );END COND
 );END WHILE
 (setvar 'clayer oldlayr)
 (setvar "Orthomode" OLDORTH)
 (*ERROR* nil)
 (PRINC))

Edited by tmelancon
Added entdel to error handler
Link to comment
Share on other sites

  • 2 weeks later...

If anybody cares to chime in I would love to learn how to make this happen. I appreciate all thoughts and help, in advance.

Link to comment
Share on other sites

I figured it out guys. I added this to my error handler. Seems to be what I needed. Thanks everyone for their help. Full code in Post #12 has been updated.

 

(and ENT (entdel ENT))

Link to comment
Share on other sites

Grrrrrrr.. Ok so after using it just now, I am noticing a problem, apparently I am writing this method wrong because if the user steps into the routine, enters a value, places the value, then chooses to esc to exit the routine, it always deletes the previously added entity. I will keep trying to figure it out when I have time today.

 

I want the routine to:

1. prompt for value

2. allow user to place value

3. loop if users wants to enter more

4. esc to exit cleanly, leaving previously entered values OR

5. if a user enters another value accidentally but no longer wants that value

6. hitting esc exits the routine then deletes the value that is currently on cursor (grread) waiting for placement- leaving the existing values the user just placed.

Link to comment
Share on other sites

Try:

(defun c:dimm (/ *error* dft dimsft elst ent oldlayr oldorth pt)
 (setq oldlayr (getvar "clayer"))
 (setq oldorth (getvar "orthomode"))
 (defun *error* (msg)
   (if oldlayr
     (setvar "clayer" oldlayr)
   )
   (if oldorth
     (setvar "orthomode" oldorth)
   )
   (if ent
     (entdel ent)
   )
   (if
     (and
       msg
       (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*BREAK*"))
     )
     (prompt msg)
   )
 )
 ; (laychk_s "dim" "5" "continuous")
 (while (setq dft (getreal "\nEnter pipe length in mm: "))
   (if
     (setq dimsft ; Can be nil.
       (cond
         ((< 1 dft 304.
           "<1'"
         )
         ((<= 304.8 dft)
           (strcat (rtos (fix (/ dft 304.) 2 0) "'")
         )
       )
     )
     (progn
       (setq ent
         (entmakex
           (list
             '(0 . "text")
             '(10 0.0 0.0 0.0)
             '(40 . 0.08)
             (cons 1 dimsft)
           )
         )
       )
       (setq elst (entget ent))
       (setvar "orthomode" 0)
       (princ "\nPlace your pipe length: ")
       (while (eq (car (setq pt (grread t 15 0))) 5)
         (entmod (subst (cons 10 (cadr pt)) (assoc 10 elst) elst))
       )
       (setq ent nil)
     )
   )
 )
 (*error* nil)
 (princ)
)

Link to comment
Share on other sites

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.

×
×
  • Create New...