Jump to content

Help Pimp My Code!

sublimation

By sublimation
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

sublimation Contributor

sublimation

Posted
Posted

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 Grand Master

BIGAL

Posted
Posted

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 Enthusiast

lido

Posted
Posted

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 Contributor

sublimation

Posted
  • Author
Posted
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.

 

image.png

image.png

sublimation Contributor

sublimation

Posted
  • Author
Posted
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 Veteran

marko_ribar

Posted
Posted

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))...

  • Like 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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)

image.thumb.png.c79f45bae8340b0a450c15305c012ec9.png

Edited by BIGAL
  • Like 1

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.

×
 Share
Go to topic listing
×
×
  • Create New...