Page 1 of 1

Can someone fine tune this macro?

Posted: Tue Jan 19, 2021 10:11 pm
by rhgrafix
This code draws an arc tangentially off lines, arcs, polylines and ellipses, it works well in Autocad but not at all in IntelliCAD. I am not good enough at code to find the problem, can someone fix it please? Thanks!

Code: Select all

;;; Created for: http://www.bricsys.com/common/support/forumthread.jsp?id=26089
;;; Author:      Roy Klein Gebbinck (www.b-k-g.nl) - this draws 2 temporary lines that stay if current layer is locked.
;;; Modified:    Marko Ribar (AutoCAD implementation)
;;; Continue arc off of arc, zero (east) of circle line, pline & 2d, ends of partial true ellipse, 1st pt of true ellipse.
(defun c:A2 ( / cmde deriv dist lst obj pt el)
  (vl-load-com)
  (if
    (and
      (setq lst (entsel))
      (setq obj (vlax-ename->vla-object (car lst)))
      (or
        (vl-position
          (vla-get-objectname obj)
          '("AcDb2dPolyline"  "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline" "AcDbSpline")
        )
        (prompt "\nError: invalid object \n")
      )
      (or
        (equal (vlax-get obj 'normal) (trans '(0.0 0.0 1.0) 1 0 T) 1e-8)
        (prompt "\nError: object not co-planar with current UCS \n")
      )
 )
    (progn
      (setq dist (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj (trans (cadr lst) 1 0))))
      (if (< dist (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) dist))
        (progn ; Closer to the start point.
          (setq pt (vlax-curve-getstartpoint obj))
          (setq deriv (mapcar '- (vlax-curve-getfirstderiv obj (vlax-curve-getstartparam obj))))
        )
        (progn
          (setq pt (vlax-curve-getendpoint obj))
          (setq deriv (vlax-curve-getfirstderiv obj (vlax-curve-getendparam obj)))
        )
      )
      (setq cmde (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (setq el (entlast))
      (vl-cmdf "_.LINE" "_non" (trans pt 0 1) "_non" (trans (mapcar '- pt deriv) 0 1) "_non" (trans pt 0 1) "")
      (while (setq el (entnext el))
        (entdel el)
      )
      (vl-cmdf
        "_.arc"
        ""
      )
      (while (> (getvar 'cmdactive) 0)
        (vl-cmdf "\\")
      )
      (setvar 'cmdecho cmde)
    )
  )
  (princ)
)

Re: Can someone fine tune this macro?

Posted: Wed Jan 20, 2021 12:20 am
by QuanNguyen
Try this:

Code: Select all

(defun c:A2 ( / cmde deriv dist lst obj pt el ent)
(vl-load-com)
(if
  (and
    (setq lst (entsel))
    (setq obj (vlax-ename->vla-object (setq ent (car lst))))
    (or
      (wcmatch (cdr (assoc 0 (entget ent))) "*LINE,ARC,CIRCLE,ELLIPSE")
      (prompt "\nError: invalid object \n")
      )
    (or
      (equal (cdr (assoc 210 (entget ent))) (trans '(0.0 0.0 1.0) 1 0 T) 1e-8)
      (prompt "\nError: object not co-planar with current UCS \n")
      )
    )
  (progn
    (setq dist (vlax-curve-getdistatpoint obj (vlax-curve-getclosestpointto obj (trans (cadr lst) 1 0))))
    (if (< dist (- (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) dist))
      (progn ; Closer to the start point.
	(setq pt (vlax-curve-getstartpoint obj))
	(setq deriv (mapcar '- (vlax-curve-getfirstderiv obj (vlax-curve-getstartparam obj))))
	)
      (progn
	(setq pt (vlax-curve-getendpoint obj))
	(setq deriv (vlax-curve-getfirstderiv obj (vlax-curve-getendparam obj)))
	)
      )
    (setq cmde (getvar 'cmdecho))
    (setvar 'cmdecho 0)
    (setq el (entlast))
    (vl-cmdf "_.LINE" "_non" (trans pt 0 1) "_non" (trans (mapcar '- pt deriv) 0 1) "_non" (trans pt 0 1) "")
    (while (setq el (entnext el))
      (entdel el)
      )
    (vl-cmdf "_.arc" "")
    (while (> (getvar 'cmdactive) 0)
      (vl-cmdf "\\"))
    (setvar 'cmdecho cmde)
    )
  )
  (princ))

Re: Can someone fine tune this macro?

Posted: Wed Jan 20, 2021 1:13 am
by rhgrafix
Yes, perfect, thank you Quan! Are there certain variable names for me to look out for or replace for future converts? If I know what to change, I might be able to fix them my self if it's a 'find and replace' type of thing. I'm not a programmer but have done a lot of "adjusting". I have a whole folder of .lsp files from my years on Autocad. One more question, do I need to keep a copy because my original code will work in only Autocad or do you think this code will work in either app? I can't test it because I don't have an active Acad license.
Thanks again,
R.L. Hamm

Re: Can someone fine tune this macro?

Posted: Wed Jan 20, 2021 7:06 am
by QuanNguyen
Hi Hamm,

Yes, it works on both IntelliCAD and AutoCAD.

Regards.

Re: Can someone fine tune this macro?

Posted: Wed Jan 20, 2021 7:39 pm
by rhgrafix
Can you tell me what you did so I can try and fix the next one that comes along?
There must be a recurring theme to look for.
Thanks.

Re: Can someone fine tune this macro?

Posted: Wed Jan 20, 2021 11:51 pm
by QuanNguyen
You can use the feature "Compare by content" of the Total Commander to find out the difference.
It's the shareware: https://www.ghisler.com/download.htm

Here's the result.
CompareByContents.png
CompareByContents.png (40.66 KiB) Viewed 588 times

Re: Can someone fine tune this macro?

Posted: Thu Jan 21, 2021 6:48 pm
by rhgrafix
Thank you.