Caliper fun

[fuccaro]

Hello people!

Today I realized that AutoCAD is just waiting on my hard disc, so I started it and I wrote a short Lisp program.

If someone wants to play: load the lisp and start it by typing TESTME in the command line. Probable you will have to double click with the wheel to get the zoom to the right place. You should see a caliper open at a random dimension. All you have to do is to read the caliper and enter the value. The command line should show at least 3 lines to see the result. Want to play again? Press enter.

While AutoCAD waits for your input, you may use the mouse to zoom/pan. Or if you want to cheat, you can measure the opening of the caliper and enter the measured value.

Have fun!

(defun c:TestMe()  
 (if (not (tblsearch "BLOCK" "SublerA")) (MakeBlockA))
 (if (not (tblsearch "BLOCK" "SublerB")) (MakeBlockB))
 (if (not (ssget "X" (list '(0 . "INSERT") '(2 . "SublerA")))) (entmake (list '(0 . "INSERT") '(2 . "SublerA") '(10 0 0 0))))
 (if (not (ssget "X" (list '(0 . "INSERT") '(2 . "SublerB")))) (entmake (list '(0 . "INSERT") '(2 . "SublerB") '(10 0 0 0))))
 (setq measured (/ (rem (getvar "millisecs") 1500) 10.0))
 (setq entl (entget (entlast)))
 (setq entl (subst (list 10 measured 0 0) (assoc 10 entl) entl))
 (entmod entl)
 (setq entered (getreal "Enter measured value "))
 (princ (if (= measured entered) "Ok " (strcat " Not Ok! The answer is " (rtos measured) )))
 (princ)
 )
(defun MakeBlockA()
 (entmake (list '(0 . "BLOCK") '(2 . "SublerA") '(10 0.0 0.0 0.0)'(70 . 0)))
 (setq i 0)
 (repeat 151
   (cond
     ((= (* 5 (/ i 5)) i) (progn
                (setq m 0.5)
                (entmake (list '(0 . "text") (list 10 i 2.6 0) (cons 1 (itoa i)) '(40 . 1.4) (cons 50 0.7)))
                )
      )
     )
   (entmake (list '(0 . "LINE") (list 10 i 0 0) (list 11 i (+ 1.5 m) 0)))
   (setq i (1+ i) m 0)
   )
 (setq points (list '(-3 0 0) '(170 0 0) '(170 8 0) '(-10 8 0) '(-10 -15 0) '(-5 -25 0) '(-5 -30 0) '(-3 -30 0)))
 (setq p1 (list -3 -30 0))
 (foreach p points
   (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p)))
   (setq p1 p)
   )
 (entmake (list '(0 . "ENDBLK")))
)

(defun MakeBlockB()
 (entmake (list '(0 . "BLOCK") (cons 2 "SublerB") (list 10 0.0 0.0 0.0)'(70 . 0)))
 (setq i 0)
 (repeat 11    
   (cond ((= i (* 5 (/ i 5))) (progn (setq n -0.5)
                (entmake (list '(0 . "text") (list 10 (- (* 0.9 i) 0.5) -5 0) (cons 1 (itoa i)) '(40 . 1.4) (cons 50 0)(cons 62 1)))
                )))
   (entmake (list '(0 . "LINE") (list 10 (* 0.9 i) 0 0) (list 11 (* 0.9 i) (+ -2 n) 0)(cons 62 1)))
   (setq i (1+ i) n 0)
   )
 (setq p1 '(-3 -30 0))
 (setq points (list '(-3 0 0) '(15 0 0) '(15 -7 0) '(4 -7 0) '(4 -15 0) '(-1 -25 0) '(-1 -30 0) '(-3 -30 0)))
  (foreach p points
    (entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p)))
   (setq p1 p)
   )
 (entmake (list '(0 . "ENDBLK")))
 )

[Lee Mac]

Great fun! Superb program fuccaro, and nice to see you posting again! - I hope all is well.

[f700es]

Welcome back

[SLW210]

Welcome back! Nice program!

[fuccaro]

Many thanks for your welcome messages, I hope you are well too!

[Grrr]

Very cool program!

BTW note that the progn functions are redundant, since cond evaluates all expressions after the test one.

 

I think it would be funny to implement grread to use that caliper for "measuring", but thats another type of program.

[fuccaro]

Thanks for that PROGN thing -I will try to remember that for the future.

[fuccaro]

And the show goes on:

Today on can buy digital micrometers but can you read the old styled ones? If you want to play, open a new drawing and set the SHADEMODE to something higher (like shaded with edges). Load the lisp and type TESTME to start it. When AutoCAD asks you to enter the value, is it possible that you see nothing on the screen. In this case use transparently the Zoom-Pan-Orbit commands. Enter the measured value and watch the command line for the result.

Oh, and I almost forgot the most important thing: have fun!

(defun c:TestMe( / dist entered)
  (MakeFixpart)
  (MakeMobilepart)
  (setq mob (entget (entlast)))
  (setq entered 0)
  (while entered
    (setq dist (/ (fix(rem (getvar "millisecs")2500)) 100.0))
    (entmod (setq mob (subst (list 10 0 0 dist) (assoc 10 mob)mob)))
    (setq rot (- dist (fix dist)) rot(if(> rot 0.5)(- rot 0.5) rot))
    (entmod (setq mob (subst (cons 50 (* rot -4 pi))(assoc 50 mob)mob)))
    (cond ((= dist(atof (setq st(getstring "Enter the measured lenght "))))(princ "OK   "))
	  (t (alert (strcat "The right answer is " (rtos dist) ", not " st ))))   
    )    
  )	
(defun MakeFixPart( / ps F3 segs ang0 ang1 r1 r2 z1 z2 p1 p2 p3 p4 o1 o2 tx pl1 pl2)
  (setq ps (list -9 0 -9 6 -3 6 -3 4 0 4 0 0 27 0 27 9 42 9 42 7 74 7))
  (setq F3 '(0 . "3DFACE"))
  (setq segs 60 ang1 (/ pi 0.5 segs) ang0 (* -11 ang1))
  (setq i 0)
  (repeat 10    
    (setq z1 (nth i ps) r1 (nth (1+ i) ps) z2 (nth (+ 2 i) ps) r2 (nth (+ i 3) ps) i (+ i 2))
    (setq o1 (list 0 0 z1) o2 (list 0 0 z2) rot (if (< i 19)(1+ segs) 54))
    (repeat rot
      (setq p1 (polar o1 ang0 r1) p2 (polar o2 ang0 r2) ang0 (+ ang0 ang1))
      (setq p3 (polar o1 ang0 r1) p4 (polar o2 ang0 r2))
      (entmake (list F3 (cons 10 p1)(cons 11 p2)(cons 12 p4)(cons 13 p3)(cons 70 5)(cons 62 253)))
      (setq p1 p3 p2 p4)
      )
    )
  (setq p3 (polar o1 (* -2 ang1) 7) p4 (polar o2 (* -2 ang1) 7))
  (entmake (list F3 (cons 10 p1)(cons 11 p2)(cons 12 p4)(cons 13 p3)(cons 62 252)))
  (setq i -5)
  (Repeat 6
    (setq tx (strcat (if (= 1 (strlen (setq tx (itoa (setq i (+ 5 i)))))) " " "") tx))
    (entmake (list '(0 . "TEXT")(cons 1 tx)
		   (list 10 1.6 (+ 42 i) 6.67)  '(40 . 3) '(210 0.865 -0.5 0) (cons 50 (/ PI 2)) (cons 41 0.6) (cons 62 255)(cons 72 0)))
   )
  (setq i -1)
  (repeat 26
    (entmake (list '(0 . "ARC") (list 10 0 0 (+ 44.95 (setq i (1+ i)))) (cons 40 7) (cons 50 (if (= (/ i 5.0) (/ i 5))6 6.15)) (cons 51 6.28) (cons 62 255)))
    (entmake (list '(0 . "ARC") (list 10 0 0 (+ 45.45 i)) (cons 40 7) (cons 50 6.28) (cons 51 6.40) (cons 62 255)))
    )
  (entdel (entlast))
  (entmake (list '(0 . "LINE") (list 10 7 0 44)(list 11 7 0 70) (cons 62 255)))
  (setq pl1 (list '(0 -3) '(18 -3) '(24 3) '(24 21) '(18 27.5) '(0 27.5)))
  (setq pl2 (list '(0 -9) '(21 -16) '(45 0) '(45 31) '(37 41.5) '(0 41.5)))
  (setq i 0)
  (repeat 5
   (entmake (list '(0 . "3DFACE")(cons 70 5) (cons 62 253)
		 (cons 10 (cons 6 (nth i pl1)))	(cons 11 (cons 6 (nth i pl2)))
		 (cons 12 (cons 6 (nth (1+ i) pl2))) (cons 13 (cons 6 (nth (1+ i) pl1)))
		 ))
      (entmake (list '(0 . "3DFACE")(cons 70 5) (cons 62 253)
		 (cons 10 (cons -6 (nth i pl1))) (cons 11 (cons -6 (nth i pl2)))
		 (cons 12 (cons -6 (nth (1+ i) pl2))) (cons 13 (cons -6 (nth (1+ i) pl1)))
		 ))
    (entmake (list '(0 . "3dface")(cons 62 253)
		   (cons 10 (cons 6 (nth i pl1))) (cons 11 (cons -6 (nth i pl1)))
		   (cons 12 (cons -6 (nth (1+ i) pl1))) (cons 13 (cons 6 (nth (1+ i) pl1)))
		   ))
    (entmake (list '(0 . "3dface")(cons 62 253)
		   (cons 10 (cons 6 (nth i pl2))) (cons 11 (cons -6 (nth i pl2)))
		   (cons 12 (cons -6 (nth (1+ i) pl2)))(cons 13 (cons 6 (nth (1+ i) pl2)))
		   ))
    (setq i (1+ i))    
    )
  (entmake (list (cons 0 "TEXT")(cons 1 "0-25 mm")(cons 40 5)(list 10 35 15 7)(list 11 35 15 8)(list 210 1 0 0)(cons 62 254)(cons 50 (/ pi 2))(cons 72 1)))
  )
(defun MakeMobilePart( / i F3 l segs ang0 ang1 o1 o2 p1 p2 p3 p4 r1 r2)
  (setq i 0)
  (repeat 10
    (entmake (list (cons 0 "block")(cons 2 (setq bn (strcat "mark" (rtos i))))(cons 70 0)(list 10 -9 0 0)))
    (entmake (list(cons 0 "text")(cons 1 (rtos i))(cons 40 3)(list 10 0 0 0)(cons 72 1)(cons 62 255)(list 210 1 0 0)))
    (entmake (list (cons 0 "endblk")))
    (setq i (+ i 5))
    )  
  (entmake (list (cons 0 "BLOCK")(cons 2 "Mobile")(cons 70 0)(list 10 0 0 0)))
  (setq l (list 0 0 0 4 45 4 45 7.2 52 9 93 9 95 7 95 4 110 4 110 0))
  (setq F3 '(0 . "3DFACE"))
  (setq segs 60 ang1 (/ pi 0.5 segs) ang0 0)
  (setq i 0)
  (repeat 9    
    (setq z1 (nth i l) r1 (nth (1+ i) l) z2 (nth (+ 2 i) l) r2 (nth (+ i 3) l) i (+ i 2))
    (setq o1 (list 0 0 z1) o2 (list 0 0 z2))
    (repeat (1+ segs)
      (setq p1 (polar o1 ang0 r1) p2 (polar o2 ang0 r2) ang0 (+ ang0 ang1))
      (setq p3 (polar o1 ang0 r1) p4 (polar o2 ang0 r2))
      (entmake (list F3 (cons 10 p1)(cons 11 p2)(cons 12 p4)(cons 13 p3)(cons 70 5)(cons 62 252)))
      (setq p1 p3 p2 p4)
      )
    )
  (knurl 65 88 9)
  (knurl 96 110 4)
  (setq o1 (list 0 0 45) r1 7.3 o2 (list 0 0 52) r2 9.1 o3 (mapcar '/ (mapcar '+ o1 o2)(list 2 2 2)) r3 (* 0.5 (+ r1 r2)))
  (setq ang 0 i -1)
  (repeat 50
    (entmake (list (cons 0 "line")
		   (cons 10 (polar o1 (setq ang (* (setq i (1+ i)) (/ pi 0.5 50))) r1))
		   (cons 11 (if (equal (/ i 5) (/ i 5.0)) (polar o2 ang r2) (polar o3 ang r3)))
		   (cons 62 255)))
    )
  (setq i -5 ang1 (/ pi 25))
  (repeat 10
    (entmake (list (cons 0 "INSERT")(cons 2 (strcat "mark" (rtos  (setq i (+ 5 i)))))(list 10 0 0 53)(cons 50 (* i ang1))))
    )  
  (entmake '((0 . "ENDBLK")))
  (entmake (list (cons 0 "insert")(cons 2 "Mobile")(list 10 0 0 0)(cons 50 0)))    
  )
(defun knurl(z1 z2 r / dr dk dkk dz segs ang0 ang1 o1 o2 o3 o4 p1 p2 p3 p4 F3) ;knurled cylinder
  (setq dr 2 dk 0.5 dkk dk dz 1)
  (setq segs 40 ang0 0 ang1 (/ pi 0.5 segs))
  (setq o1 (list 0 0 z1) o2 (list 0 0 (+ z1 dz)) o3 (list 0 0 (- z2 dz))o4 (list 0 0 z2))
  (setq p1 (polar o1 0 r) p2 (polar o2 0 (+ r dr dk)) p3 (polar o3 0 (+ r dr dk)) p4 (polar o4 0 r))
  (setq F3 '(0 . "3DFACE"))
  (repeat (1+ segs)
    (setq dk (abs (- dk dkk))ang0 (+ ang0 ang1))
    (setq p5 (polar o1 ang0 r))
    (setq p6 (polar o2 ang0 (+ r dk dr)))
    (setq p7 (polar o3 ang0 (+ r dk dr)))
    (setq p8 (polar o4 ang0 r))
    (entmake (list F3 (cons 10 p1)(cons 11 p2)(cons 12 p6)(cons 13 p5)(cons 70 5)(cons 62 253)))
    (entmake (list F3 (cons 10 p2)(cons 11 p3)(cons 12 p7)(cons 13 p6)(cons 62 253)))
    (entmake (list F3 (cons 10 p3)(cons 11 p4)(cons 12 p8)(cons 13 p7)(cons 70 5)(cons 62 253)))    
    (setq p1 p5 p2 p6 p3 p7 p4 p8)
    )
  )
(eval "type TESTME to start")

 

[Jef!]

Hi Funnaro!

Nice 3d update! On my side, I always get negative dimensions (so the top part is over travelling through the bottom part) 

Still more fun than typical drawings

[fuccaro]

Ok Jef!, thanks for playing with my program and also thanks for alerting me on that.

If really "always" gives you a negative number then you could change the 7th line of the prog like this:

(setq dist (/ (fix(rem (getvar "millisecs")2500)) -100.0))

see the minus sign at the end.

I will try to find out the root cause of the problem, in the mean time you may have an other look to my name.

[fuccaro]

Sorry Jef!, but I can't reproduce the error. I see in your image that you changed the UCS... Even so on my computer it works fine.

Let's ask others to test it. Please people, give me a hand, post a feed-back. Thanks!

[steven-g]

Works fine for me, are you having a slow day at the office

[Jef!]

13 hours ago, fuccaro said:

Sorry Jef!, but I can't reproduce the error. I see in your image that you changed the UCS... Even so on my computer it works fine.

Let's ask others to test it. Please people, give me a hand, post a feed-back. Thanks!

Well yeah I changed the ucs, I have to put in ucs right to see it. In world ucs I see it from top, and can't see much. I tried it again today, works good on any ucs. I think the issue was on my side, 75% of the time I copy code from this new forum platform (using chrome), it copies some empty span html tags that are not always visible when I paste and when it does I get really weird/unexpected results. Sorry for the false flag!

[fuccaro]

I am glad to see that it works for you too. You can adjust the view angle on the fly with Shift+Middle button, no need to rotate the UCS.

Try to paste in Notepad first and from there save the file or just copy-paste in AutoCAD.

Thanks again for playing with my program and giving feed-back. I wish you a nice day!