Help Pimp My Code!

[sublimation]

I need a little help with my code on two fronts. 

 

First, when I run my program I get my "Circle does not exist" error message constantly, even when I think the program should be finding two valid circles.  I just can't see the issue. 

 

Second, without writing the code for me, could you show me where in my code I should be adding error checking, and what kind of error checking I should be looking into?  This is my longest program to date, and I think I need to start getting a better grasp on how to stabilize my programs.

 

Thank you all for your help!

 

(defun C:BUBBLES (/ rn
                    rmax
                    RR
                    r
                    i
                    pt1
                    ss
                    tan-rs
                    tan-ctrs
                    c-obj
                    cntrpt
                    ptBx
                    {ACADAPP}
                    {ACADDOC}
                    {MODELSPACE}
                    LM:rand
                    LM:randrange
                    Pt->ssBB
                    Pt->ssCircle
                    PresicionRound
                    SelectionSet->VLA-Object
                    LM:inters-circle-circle)

    (setq {ACADAPP} (vlax-get-acad-object))
    (setq {ACADDOC} (vla-get-activedocument {ACADAPP}))
    (setq {MODELSPACE} (vla-get-modelspace {ACADDOC}))

    ;; Rand  -  Lee Mac
    ;; PRNG implementing a linear congruential generator with
    ;; parameters derived from the book 'Numerical Recipes'
    (defun LM:rand ( / a c m )
        (setq m   4294967296.0
              a   1664525.0
              c   1013904223.0
              $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
        )
        (/ $xn m)
        )

    (defun LM:randrange (a b)
        (+ (min a b) (* (LM:rand) (abs (- a b))))
        )

    (defun Pt->ssBB (pt d)
        (if (not (listp d))
            (setq d (list d d))
            )
        (mapcar '(lambda (s)
                    (apply 'mapcar (list s pt d))
                    )
                    '(- +)
            )
        )

    (defun Pt->ssCircle (pt r n / rdns i ptlst)
        (setq rdns (/ pi (/ n 2))
              ptlst '()
              i '0)
        (repeat n
            (setq i (1+ i)
                  ptlst (cons (polar pt (* i rdns) r) ptlst))
            )
        )

    (defun PresicionRound (n p / xn )
        (setq xn (expt 10.0 (- p)))
        (* xn (fix ((if (minusp n) - +) (/ n (float xn)) 0.5)))
        )

    (defun SelectionSet->VLA-Object (ssEnts / obj cnt)
        (if ssEnts
            (repeat (setq cnt (sslength ssEnts))
                (setq obj (cons (vlax-ename->vla-object (ssname ssEnts (setq cnt (1- cnt)))) obj))
                )
            )
        )

    (defun LM:inters-circle-circle ( c1 r1 c2 r2 / a d m l x y mxv)
        (defun mxv ( m v )
            (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
            )

        (if (and (<= (setq d (distance c1 c2)) (+ r1 r2))
                 (<= (abs (- r1 r2)) d)
                )
            (progn
                (if (equal r1 (setq x (/ (- (+ (* r1 r1) (* d d)) (* r2 r2)) (+ d d))) 1e-8)
                    (setq l (list (list x 0.0 0.0)))
                    (setq y (sqrt (- (* r1 r1) (* x x)))
                          l (list (list x y 0.0) (list x (- y) 0.0))
                        )
                    )
                (setq a (angle c1 c2)
                      m (list (list (cos a) (- (sin a)) 0) (list (sin a) (cos a) 0) '(0 0 1))
                    )
                (mapcar '(lambda ( v ) (mapcar '+ c1 (mxv m v))) l)
                )
            )
        )

    (while (setq pt1 (getpoint "\nSpecify Location For Next Object: "))
        (setq i '1
              c-obj nil
              rn (fix (1+ (LM:randrange 1 30))))

        (cond ; these percentages are weird - analyse, maybe add dcl interface and sliders to adjust the ratios
            ((< rn 21) (setq rmax 0.25))
            ((> rn 24) (setq rmax 0.3125))
            ((and (< rn 24) (> rn 20)) (setq rmax 0.50))
            (T (setq rmax 0.75))
            )

        (setq RR '(PresicionRound (LM:randrange 0.125 rmax) 3)
              r (eval RR))

        (while (< i 20)
            (while (and (< (if (not (setq ss (ssget "_CP" (Pt->ssCircle pt1 (+ r (* i 0.5)) 36) '((0 . "CIRCLE")(8 . "0"))))) 0 (sslength ss)) 1) (<= i 20))
                (setq i (1+ i))
                )

            (if ss
                (progn
                    (setq ss (SelectionSet->VLA-Object ss)
                          ss (nth (car (vl-sort-i ss '(lambda (a b) (< (- (distance (vlax-get a 'center) pt1) (vla-get-radius a) r) (- (distance (vlax-get b 'center) pt1) (vla-get-radius b) r))))) ss)
                          ss (ssget "_CP" (Pt->ssCircle (vlax-get ss 'center) (* (+ (vla-get-radius ss) (* r 2)) 1.02) 20) '((0 . "CIRCLE")(8 . "0"))))

                    (if (>= (sslength ss) 2)
                        (progn
                            (setq ss (SelectionSet->VLA-Object ss)
                                  ss (vl-sort ss '(lambda (a b) (< (- (distance (vlax-get a 'center) pt1) (vla-get-radius a) r) (- (distance (vlax-get b 'center) pt1) (vla-get-radius b) r))))
                                  ss (mapcar 'nth '(0 1) (list ss ss ss)) ;;; added extra ss incase the program later allows for 3 tangents
                                  tan-rs (mapcar '+ (mapcar 'vla-get-radius ss) (list r r r)) ;;; added extra r ...
                                  tan-ctrs (mapcar 'vlax-get ss '(center center center)) ;;; added extra center ...
                                  cntrpt (car (vl-sort (LM:inters-circle-circle (car tan-ctrs) (car tan-rs) (cadr tan-ctrs) (cadr tan-rs)) '(lambda (a b) (< (distance a pt1) (distance b pt1)))))
                                  ptBx (Pt->ssBB cntrpt (* r 1.1))
                                  ss (SelectionSet->VLA-Object (ssget "_C" (car ptBx) (cadr ptBx) '((0 . "CIRCLE")(8 . "0")))))

                            (if (apply 'and (mapcar '(lambda (x) (if (<= (+ r (vla-get-radius x)) (distance cntrpt (vlax-get x 'center))) T nil)) ss))
                                (progn
                                    (setq c-obj (vla-AddCircle {MODELSPACE} (vlax-3d-point cntrpt) r)
                                          i '100)
                                    (vla-Regen {ACADDOC} :vlax-true)
                                    )
                                (setq r (eval RR)
                                      i (* i 2))
                                )
                            )
                        (setq r (eval RR)
                              i (* i 2))
                        )
                    )
                )
            (if (and (>= i 20) (not c-obj))
                (princ "\nCircle does not exist.")
                )
            (setq ss nil)
            )
        (princ)
        )
    )

 

[BIGAL]

Looked at code but did not run an image would have helped a lot, often tasks can be reduced in coding. A before after.

[lido]

What you expect to do your code?

To debug, I recommend the function alert.

 

In your code, selection set ss is nil:

..................
(while (and (< (if (not (setq ss (ssget "_CP" (Pt->ssCircle pt1 (+ r (* i 0.5)) 36) '((0 . "CIRCLE")(8 . "0"))))) 0 (sslength ss)) 1) (<= i 20))
   (setq i (1+ i))
)

(alert
(strcat
"ss: "
(vl-princ-to-string ss)
"\n(Pt->ssCircle pt1 (+ r (* i 0.5)) 36): "
(vl-princ-to-string (Pt->ssCircle pt1 (+ r (* i 0.5)) 36))
)
)

(if ss
.....................

 

[sublimation]

42 minutes ago, BIGAL said:

Looked at code but did not run an image would have helped a lot, often tasks can be reduced in coding. A before after.

 

My apologies.  I have a tendency to forget to include important information that people need.  It's a hard habit to break.

• (vl-load-com) is missing from the program.  I always have it on in other programs and forgot to include it.
• Also, you have to start with two user made circles.  First image.  (I know, a pretty important detail.)
• When the program is run, you should be able to click in an open space and it creates a random tan tan circle at a point closest to your pick point.  Creating the second image.  Most of the time however, I just get my "Circle does not exist." error message. 

Please let me know if I've failed to included everything needed.

 

[sublimation]

34 minutes ago, lido said:

What you expect to do your code?

To debug, I recommend the function alert.

 

I forgot to include valuable information.  See above.

 

It should run correctly the majority of the time, I just can't see why it doesn't create a circle the rest of the time.

[marko_ribar]

Here in attachment is something I revised recently... Take a look at the code, it also deals with circles tangents, but in various combinations of LINE, CIRCLE and POINT as reference objects... Look at Lee's ci1xci2 sub (trans) version that I slightly modified - I would use that sub instead of your version...

Link :

http://www.theswamp.org/index.php?topic=39567.msg449135#msg449135

 

HTH., M.R.

(Also worth noting : There is command CIRCLE - 3p (tan, tan, tan) or CIRCLE - TTR (tan, tan, radius))...

[BIGAL]

For me pick point, use ssget "F" actually a polygon keep increasing till ssget find 2 circles then like marko use TTR with random radius. The approx. tan point is circle cen to picked point intersection. Interesting idea have done a few random patterns including a 3d tree ball of leaves.

 

Try this includes 1st 2 circles, note it seems to work as it tries to find only 2 circles so if it misses keeps going no real check for after 50. Circles should be radius 1 to 30. Big circle be a little away small up closer. 

 

Note the Briscad polygon difference, need to find the check what am I running know about product key but Briscad does not like something when using it.

 

;; Rand  -  Lee Mac
    ;; PRNG implementing a linear congruential generator with
    ;; parameters derived from the book 'Numerical Recipes'
    (defun LM:rand ( / a c m )
        (setq m   4294967296.0
              a   1664525.0
              c   1013904223.0
              $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
        )
        (/ $xn m)
        )

    (defun LM:randrange (a b)
        (+ (min a b) (* (LM:rand) (abs (- a b))))
        )

; Adds a random radius circle berween 2 existing circles.
; By AlanH March 2020 info@alanh.com.au

(defun c:3rdcirc (/ pt obj1 obj2 obj3 inc cen intpt1 intpt2 rad ss)
(vl-load-com)
  (setq rad (fix (1+ (LM:randrange 1 30))))
  (command "circle" (getpoint "\pick point for 1st circle") rad)
  (command "circle" (getpoint "\pick point for 2nd circle") rad)
  (while (setq pt (getpoint "\npick a point Enter to exit"))
    (setq inc 1.0)
    (setq rad (fix (1+ (LM:randrange 1 30))))
    (while (< inc 50)
    (command "polygon" 20 pt "I" inc) ; Autocad

	; (command "polygon" 20 pt (polar pt 0.0 inc)) ; Briscad
      
      (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
      (setq ss (ssget "F" co-ord (list (cons 0 "circle"))))
      (if (and (/= ss nil) (= (sslength ss) 2))
        (progn
          (setq inc 51)
          (command "erase" (entlast) "")
          (setq obj1 (vlax-ename->vla-object (ssname ss 0)))
          (setq cen (vlax-get Obj1 'Center))
          (command "line" cen pt "")
          (setq obj3 (vlax-ename->vla-object (entlast)))
          (setq intpt1 (vlax-invoke obj3 'intersectWith obj1 acExtendNone))
          (command "erase" (entlast) "")
          (setq obj2 (vlax-ename->vla-object (ssname ss 1)))
          (setq cen (vlax-get Obj2 'Center))
          (command "line" cen pt "")
          (setq obj3 (vlax-ename->vla-object (entlast)))
          (setq intpt2 (vlax-invoke obj3 'intersectWith obj2 acExtendNone))
          (command "erase" (entlast) "")
          (command "circle" "TTR" intpt1 intpt2 Rad)
        )
        (progn
          (setq inc (+ inc 1.0))
          (command "erase" (entlast) "")
        )
      )
    )
  )
  (princ)
)
(c:3rdcirc) 

Edited March 23, 2020 by BIGAL