Beginner's Programming Challenge

[john.uhden]

This challenge is NOT for the omnipresent brainiacs who solve the problems of all the needy.

This challenge is to write a function that takes two (2) entity names of two (2) separate circles to see if they are concentric.  The function should return either T or 1 for true and nil for not concentric.

Your code is limited to no more than 25 lines.  A line that word-wraps will be considered as multiple lines.

No help from the regulars is permitted.

First prize will be a weekend in Chatsworth, NJ.  2nd prize will be 5 days in a row in Chatsworth, NJ.

You will have to bring your own pick-up truck and potable water.

[calderg1000]

Thank you dear @john.uhden 

For the challenge. I put the following code for your consideration, I hope your appreciation.

(defun c:ct (/ s i sn c lp dt)
  (setq s (ssget '((0 . "circle"))))
  (repeat (setq i (sslength s))
    (setq sn (entget (ssname s (setq i (1- i))))
          c  (cdr (assoc 10 sn))
    )
    (setq lp (cons c lp))
  )
  (setq dt (distance (cadr lp) (car lp)))
  (if (zerop dt)
    t
  )
)
;;;.............................................
(defun c:ct1 (/ s i sn c lp )
  (setq s (ssget '((0 . "circle"))))
  (repeat (setq i (sslength s))
    (setq sn (entget (ssname s (setq i (1- i))))
          c  (cdr (assoc 10 sn))
    )
    (setq lp (cons c lp))
  )
  (if (equal (nth 0 lp) (nth 1 lp))
    t
  )
)

[john.kaulB9QW2]

---

@john.uhden wrote:

Beginner's Programming Challenge

--->%
This challenge is to write a function that takes two (2) entity names of two
(2) separate circles to see if they are concentric. The function should return
either T or 1 for true and nil for not concentric.
--->%

---

NOTE: Ignoring instructions to keep code to a minimum number of lines because line count is not related to the solution. 

Steps to solve:
1. Allow user to select circles.
2. Pass two ent names to a function that checks to see if two coordinates match.

Potential Problems:
1. What if user hits ESC during selection(s).
2. What if user does not select a circle (and selects a line, for example).

SOLUTION:
1. allow user to pick an ent.

(defun pick-something ()
  ;; pick something
  ;;
  ;; RETURNS: entname or nil
  (car (entsel)) )

2. define a function that accepts two ent names and checks to see if two coordinates match.

(defun check-concentric (ent1 ent2)
  ;; check-concentric
  ;; Accepts two entity names and checks to see if center points are the same.
  ;;
  ;; RETURNS: T or NIL
  ;;
  (apply 'and
         ;; we will apply the AND function to see if we get all T's.
         (mapcar '=
                 ;; We will iterate the list and compare each items in
                 ;; both lists to see if they are the same (this
                 ;; should return either "nil" or "T" for each item checked.
                 (assoc 10 (entget ent1))
                 ;; this call shoulc return a list of numbers like:
                 ;; (10 20.0044 22.5881 0.0)
                 (assoc 10 (entget ent2)))) )

TRIAL:
(check-concentric (pick-something) (pick-something))

EVALUATION: UGH! Horrible!
1. We do not check to see if user selects a circle.
2. we do not account for mis-picks
3. Our `check-concentric` function is doing too much; functions should do "one thing" or as little as possible.

Problems 1 and 2 are bigger topics but 3 is easy to fix so let's address that right away.

We can divide the tasks of checking equality and getting entities into smaller function(s).

Here is a function that checks two lists for equality.

(defun check-eq (lst1 lst2)
  ;; check-eq
  ;; Accepts two lists to check to see if equal
  ;;
  ;; RETURNS: T of NIL
  ;;
  ;; TEST: (check-eq '(1 2 3 4) '(1 2 3 4))
  ;;       > T
  ;;       (check-eq '(1 2 3 4) '(a b c d))
  ;;       > nil
  (apply 'and (mapcar '= lst1 lst2)) )

Now we can redo our `check-concentric` function

(defun check-concentric (ent1 ent2)
  ;; check-concentric
  ;; Accepts two entity names and checks to see if center points are the same.
  ;;
  ;; RETURNS: T or NIL
  (check-eq
    (assoc 10 (entget ent1))
    (assoc 10 (entget ent2))) )

EVALUATION: We managed to fix problem #3. Let's move on.

Problem 2 (mis-picks).
We can account for mis-picks by looping until we actually get a good pick from the user.

(defun pick-something ()
  ;; pick-something
  ;; This offers a slightly better `entsel` routine
  ;; which will keep looping until the user picks
  ;; an item.
  ;;
  ;; RETURNS: entname or nil
  (cond
    ((car (entsel)))
    ((princ "\nYou missed, try again.")
     (pick-something))) )

; EXAMPLE USE:
; (check-concentric (pick-something) (pick-something))

Problem 1 (check ent type).

We can check to see if the item picked is actually a circle like this:

(defun check-circle (ent)
  ;; check-circle
  ;; Accepts an ent-name and checks to see if
  ;; it is a circle type
  ;;
  ;; RETURNS: T or NIL
  (eq "CIRCLE" (cdr (assoc 0 (entget ent)))) )

We can use our `check-circle` function like this:

(defun check-two-circles ( / ent1 ent2)
  (setq ent1 (pick-something)
        ent2 (pick-something))
  (if (and
        (check-circle ent1)
        (check-circle ent2))
    (check-concentric ent1 ent2))
  )

So, our final code should be:

FINAL CODE:

NOTE: This should be "better" but it still isn't "great/good" nor is it the only way to solve this problem(s). To develop "good" code takes time, tests, and forethought. This was just a good introduction for new programmers into proper "thought process". 

(defun check-eq (lst1 lst2)
  ;; check-eq
  ;; Accepts two lists to check to see if equal
  ;;
  ;; RETURNS: T of NIL
  ;;
  ;; TEST: (check-eq '(1 2 3 4) '(1 2 3 4))
  ;;       > T
  ;;       (check-eq '(1 2 3 4) '(a b c d))
  ;;       > nil
  (apply 'and (mapcar '= lst1 lst2)) )

(defun check-concentric (ent1 ent2)
  ;; check-concentric
  ;; Accepts two entity names and checks to see if center points are the same.
  ;;
  ;; RETURNS: T or NIL
  ;;
  (check-eq
    (assoc 10 (entget ent1))
    (assoc 10 (entget ent2))) )

(defun pick-something ()
  ;; pick-something
  ;; This offers a slightly better `entsel` routine
  ;; which will keep looping until the user picks
  ;; an item.
  ;;
  ;; RETURNS: entname or nil
  (cond
    ((car (entsel)))
    ((princ "\nYou missed, try again.")
     (pick-something))) )

(defun check-circle (ent)
  ;; check-circle
  ;; Accepts an ent-name and checks to see if
  ;; it is a circle type
  ;;
  ;; RETURNS: T or NIL
  (eq "CIRCLE" (cdr (assoc 0 (entget ent)))) )

(defun check-two-circles ( / ent1 ent2)
  ;; Checks if two circles are concentric
  ;;
  ;; RETURNS: T or NIL
  (setq ent1 (pick-something)
        ent2 (pick-something))
  (if (and
        (check-circle ent1)
        (check-circle ent2))
    (check-concentric ent1 ent2))
  )

[john.uhden]

@calderg1000 

Great code, and consistent too!

Drew 5 circles (one offset), and got nil every time. 😵

[john.uhden]

@john.kaulB9QW2 

Didn't I say no participation by regulars and that newbies cannot get assistance from above?

Now every newbie will be submitting your code looking for an acceptance.

Okay, I guess that's fine, except what they submit may be error laden.  👻

Just think of the poor youngsters whose hopes will be dashed.  😭

[john.kaulB9QW2]

Awe!? I thought I "made a good". I am not a regular and I am technically a Lisp newbie (again) so I solicited no help from any regular user and I coded it up to somewhat "okay quality" (not perfect but the basic infrastructure is there for improvements). But why would anyone's hopes be dashed and error laden?

[calderg1000]

Regards @john.uhden 

Another approach with the same idea using Vlisp, it works for only the selection of 2 circles.

Do not imagine competing with @john.kaulB9QW2 , but it is a privilege, although I will not win the prize for sure.

(defun c:ct2(/ s i an nn x ar)
  (setq s (ssget '((0 . "circle"))))
  (repeat (setq i (sslength s))
    (setq an (ssname s (setq i (1- i)))
          nn (cons an nn)
    )
  )
  (foreach x nn
    (setq an (vlax-ename->vla-object x)
          ar (cons (vlax-safearray->list (vlax-variant-value (vla-get-center an)))
                   ar
             )
    )
  )
  (if (equal (nth 0 ar) (nth 1 ar))
    t
  )
)

[john.kaulB9QW2]

I have a meeting in 2 minutes so very quickly.
First: what you do you mean you cannot complete with me?! You just did! 🙂
Second: your last "return" can be reduced to just equal
(equal (nth 0 ar) (nth 1 ar))
Third: NTH is slow. use "CAR" "CADR" type functions when you can (like in this case where we only have two items).
(car ar)
(cadr ar)

I'll try to check back later.

Good job, calderg1000.

[Kent1Cooper]

---

@calderg1000 wrote:

....

Another approach .... it works for only the selection of 2 circles.

---

It allows the selection of any number of Circles, but compares the centers of only two of them [the last two in the selection set].

I am, as a "regular," withholding my solution that prevents selection of more [or fewer] than two Circles, and scolds you and asks again if you violate that.  [Total 12 lines of code.]

[john.uhden]

@calderg1000 

Oh, I get it now.  I had missed the rule about selecting only 2 circles.

It works!

BTW, though it was a little verbose, you are well on your way to competing with anyone.  Another 15 years and you'll be an Expletive Elite too.  🤕

[john.uhden]

John,

You seriously need to learn the Kosterian (and ................) approach

[ronjonp]

@calderg1000  I know I'm not supposed to help for some reason but:

;; This
(foreach x nn
  (setq	an (vlax-ename->vla-object x)
	ar (cons (vlax-safearray->list (vlax-variant-value (vla-get-center an))) ar)
  )
)
;; Could be shortened to this
(foreach x nn (setq ar (cons (vlax-get (vlax-ename->vla-object x) 'center) ar)))
;; Although I prefer DXF for the most part. No need to convert to vla when the same info is available via DXF.
(foreach x nn (setq ar (cons (cdr (assoc 10 (entget x))) ar)))

[calderg1000]

Thanks @ronjonp, I knew there was a way to avoid all the long way of transforming the Variant, but I didn't have it at hand, Now my code will have a few lines less.
A pleasure to greet.

[john.uhden]

@ronjonp 

You were supposed to keep your hands off so that you didn't embarrass yourself.

But you couldn't help it, and did so anyway, and forced my hand.

I don't think it gets any easier than...

(defun concentric (e1 e2)
  (equal (assoc 10 (entget e1))(assoc 10 (entget e2)) 1e-8)
)

But @dbroad is sure to prove me wrong.

[john.kaulB9QW2]

>Kosterian
Link/writeup/explanation please. Allow me to place a guess based on "(and..."; use AND instead of the (if [predicate] [consequent] [alternative]) construct? Nice idea but I type too many IF statements in C to change now (the autolisp logical tools--AND, OR--is wacky and you just cannot do that stuff in C flavored languages).

[john.kaulB9QW2]

I think there are several entities with DXF code 10 for stuff (like blocks, elipse, etc)?

[Kent1Cooper]

---

@john.kaulB9QW2 wrote:
I think there are several entities with DXF code 10 for stuff (like blocks, elipse, etc)?

---

Yes, also including Points, Text/Mtext, the vertices of LWPolylines, elements of Splines, etc.  But it doesn't matter, since the selection can be restricted to Circles only before a routine ever gets to the point of comparing (assoc 10) values.

[john.kaulB9QW2]

ronjonp, you will be excited to know that after further review you are/were not in the wrong since no one solicited your response and therefore not in violation of the rules.

[john.uhden]

John,

Even though you haven't been here that long, you should have picked up by now that I like to tease people somewhat.  Not everyone likes it, but I like the people who do, especially when they tease me back.

Anyway, I was treating YOU as a regular, and that any newbies would be "borrowing" your code.  Of course, then I couldn't resist implying that what they took would be faulty <snicker>.

It's sorta like the time years ago that I thought I had solved the point inside a polyline issue, and I wrote "Look, Ma, no rays."  But what I posted didn't contain a required function.  To which Jim Fischer, I think, replied "Look, John, no function."  I was properly chastised and we had a lot of fun out of it.

Keep up the good work!

[dbroad · Accepted solution]

That's exactly what I came up with.  We could really call it a one liner though. Just don't indent.

For the others using a vl approach, consider how you can avoid the need to convert variants. To me, its a bit more readable.

;determine whether 2 circle objects are concentric within fuzz error.
(defun concentric (co1 co2 fuzz)
  (equal (vlax-get co1 'center) (vlax-get co2 'center) fuzz))