help with writing a lisp routine of tangent-tangent angle

[Anonymous]

could someone write a lisp routine that inserts a circle with a diameter of .0938 into a drawing at all instances of tangent-tangent angle?

below is an example of what this would look like:

[Anonymous]

could someone write a lisp routine that inserts a circle with a diameter of .0938 into a drawing at all instances of tangent-tangent angle?

below is an example of what this would look like:

[rkmcswain]

This is a duplicate post of https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/help-with-writing-a-lisp-routine/m-p...

[Kent1Cooper]

Are those Lines, or Polylines, or....?  Operational questions also arise:  Would the User select the ones they want this done on, or should a routine try to find all of them itself?  Are they differentiatable from other such objects, such as by being within a limited range of length or something?  Are the corners always perpendicular?  Etc., etc. -- any more detail you can provide would be helpful.

[Anonymous]

yeah, sorry about that.  I received an error that the listing wouldn't post so I tried again.  Guess it did post afterall.. not sure how to delete the other posting...

[Anonymous]

They are polylines. The user could select or the routine could search to find all instances (I have no preference at this point as I believe either scenario would work) They will not be differential from other objects. Ideally this would apply to all instances of angles within the range of 10-179 degrees. Hope that helps.

[Ranjit_Singh · Accepted solution]

Something like the following may work. Minimal testing and no error trap.

;;Ranjit Singh
;;8/25/17
(defun c:somefunc  (/ adoc c rad ss1 var)
 (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq rad (getdist "\nSpecify radius of circle: ")
       ss1 (ssget '((0 . "lwpolyline")))
       var (mapcar 'getvar '(osmode cmdecho nomutt)))
 (and ss1
      (mapcar 'setvar '(osmode cmdecho nomutt) '(0 0 1))
      (mapcar '(lambda (y)
                (mapcar '(lambda (x)
                          (command-s "._circle"
                                     (setq c (mapcar '/ (mapcar '+ (car x) (cadr x)) '(2 2)))
                                     (vlax-curve-getclosestpointto y c))
                          (command-s "._scale" (entlast) "" (last x) (/ rad (cdr (assoc 40 (entget (entlast)))))))
                        (mapcar '(lambda (x) (mapcar '(lambda (x) (vlax-curve-getpointatdist y x)) (list (- x rad) (+ x rad) x)))
                                (mapcar '(lambda (x) (vlax-curve-getdistatpoint y x))
                                        (cdr (reverse (cddr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget y)))))))))))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
      (mapcar 'setvar '(osmode cmdecho nomutt) var))
 (vla-endundomark adoc)
 (princ))

[Ranjit_Singh · Accepted solution]

One, of probably many possible methods, is posted here. Adding here for reference

;;Ranjit Singh
;;8/25/17
(defun c:somefunc  (/ adoc c rad ss1 var)
 (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq rad (getdist "\nSpecify radius of circle: ")
       ss1 (ssget '((0 . "lwpolyline")))
       var (mapcar 'getvar '(osmode cmdecho nomutt)))
 (and ss1
      (mapcar 'setvar '(osmode cmdecho nomutt) '(0 0 1))
      (mapcar '(lambda (y)
                (mapcar '(lambda (x)
                          (command-s "._circle"
                                     (setq c (mapcar '/ (mapcar '+ (car x) (cadr x)) '(2 2)))
                                     (vlax-curve-getclosestpointto y c))
                          (command-s "._scale" (entlast) "" (last x) (/ rad (cdr (assoc 40 (entget (entlast)))))))
                        (mapcar '(lambda (x) (mapcar '(lambda (x) (vlax-curve-getpointatdist y x)) (list (- x rad) (+ x rad) x)))
                                (mapcar '(lambda (x) (vlax-curve-getdistatpoint y x))
                                        (cdr (reverse (cddr (reverse (vl-remove-if-not 'listp (mapcar 'cdr (entget y)))))))))))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1))))
      (mapcar 'setvar '(osmode cmdecho nomutt) var))
 (vla-endundomark adoc)
 (princ))

[john.uhden]

I haven't studied the code, but I am very impressed with the results!

How are the results of your painting project?

[marko_ribar]

I'll be **** if those two codes posted aren't the same... Where is the catch if I am missing it?

[braudpat]

Hello Rendit

1) BEAUTIFUL Routine !

2) French humour: now you must have a serious handicap !
You are forbidden to use MAPCAR !!

Regards, Patrice

[john.uhden]

A good friend of mine, now deceased, always spoke of his favorite french breakfast... "a roll in bed with honey."  🙂