tmelancon Posted June 27, 2017 Share Posted June 27, 2017 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)) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted June 28, 2017 Share Posted June 28, 2017 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. Quote Link to comment Share on other sites More sharing options...
tmelancon Posted June 28, 2017 Author Share Posted June 28, 2017 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) ) ) ) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted June 28, 2017 Author Share Posted June 28, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted June 28, 2017 Author Share Posted June 28, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
ronjonp Posted June 28, 2017 Share Posted June 28, 2017 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" "" ) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted June 28, 2017 Author Share Posted June 28, 2017 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] "" ) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 7, 2017 Author Share Posted July 7, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 8, 2017 Share Posted July 8, 2017 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) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 8, 2017 Author Share Posted July 8, 2017 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") Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 8, 2017 Share Posted July 8, 2017 Exactly add Linetype as well. As your writing code for say a company use it makes standardising layer names etc so much easier. Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 12, 2017 Author Share Posted July 12, 2017 (edited) 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 July 26, 2017 by tmelancon Added entdel to error handler Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 25, 2017 Author Share Posted July 25, 2017 If anybody cares to chime in I would love to learn how to make this happen. I appreciate all thoughts and help, in advance. Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 26, 2017 Author Share Posted July 26, 2017 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)) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 26, 2017 Author Share Posted July 26, 2017 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. Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted July 27, 2017 Share Posted July 27, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
tmelancon Posted July 28, 2017 Author Share Posted July 28, 2017 Roy I do appreciate your input! This worked out fantastically! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.