Parallel xline

[Browning_Zed]

Hi!
Here on the forum I found a lisp code that creates an xline perpendicular to the selected entity (line, polyline, circle, etc.). The code works as it should, but I would like to change it so that a parallel is created instead of the perpendicular. How to do it?

(defun c:perxl ( / *error* acadobj adoc crv msp perpt pt)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (setq acadobj (vlax-get-acad-object)
	adoc (vla-get-ActiveDocument acadobj)
	msp (vla-get-ModelSpace adoc)
	)
  
  (vla-StartUndoMark adoc)
  (while
    (progn
      (setq crv (entsel "\nSelect curve: "))
      (cond
	((null crv) (princ "\nNothing selected"))
	((null (wcmatch (cdr (assoc 0 (entget (car crv)))) "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))
	 (princ "\nObject is not a curve")
	 )
	)
      )
    )
  
  (initget 1)
  (setq pt (getpoint "\nSpecify point: ")
	perpt (vlax-curve-getclosestpointto (car crv) pt)
	)
  (vla-AddXline msp (apply 'vlax-3d-point pt) (apply 'vlax-3d-point perpt))
  (vla-EndUndoMark adoc)
  )

[ВeekeeCZ]

IMHO this looks you're rather inefficient working with your osnaps or must do this kind of job like a thousand times a day. Because it's all about osnaps.

Anyway, this following version of PerXl gives me much more sense (for ACAD 2016+).

HTH

(defun c:PerXl nil
  (command-s "_.xline" "_per")
  (princ)
  )

(defun c:TanXl nil
  (command "_.xline" pause "_tan" pause "")
  (princ)
  )

Edit: Did you really meant "a parallel" rather than "tangent"?

[marko_ribar · Accepted solution]

Based on your posted code...

(defun c:parxl ( / *error* acadobj adoc crv msp perpt pt fd )

  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
    )
  )

  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
  )

  (vla-StartUndoMark adoc)
  (while
    (progn
      (setq crv (entsel "\nSelect curve: "))
      (cond
        ((null crv) (princ "\nNothing selected..."))
        ((null (wcmatch (cdr (assoc 0 (entget (car crv)))) "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,HELIX"))
         (princ "\nObject is not a curve...")
        )
      )
    )
  )

  (initget 1)
  (setq pt (getpoint "\nSpecify point: ")
        perpt (vlax-curve-getclosestpointto (car crv) pt)
        fd (vlax-curve-getfirstderiv (car crv) (vlax-curve-getparamatpoint (car crv) perpt))
  )
  (vla-AddXline msp (apply 'vlax-3d-point pt) (apply 'vlax-3d-point (mapcar '+ pt fd)))
  (vla-EndUndoMark adoc)
  (princ)
)

[ВeekeeCZ]

Little different approach. 

(defun c:parxl ( / *error* acadobj adoc crv msp parpt pt fd )
  
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (setq acadobj (vlax-get-acad-object)
	adoc (vla-get-ActiveDocument acadobj)
	msp (vla-get-ModelSpace adoc)
	)
  (vla-StartUndoMark adoc)
  
  (while (progn
	   (setq crv (entsel "\nSelect curve: "))
	   (cond ((null crv)
		  (princ "\nNothing selected"))
		 ((null (wcmatch (cdr (assoc 0 (entget (car crv)))) "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))
		  (princ "\nObject is not a curve")))))
  
  (while (setq pt (getpoint "\nSpecify point: "))
    (setq parpt (vlax-curve-getclosestpointto (car crv) (cadr crv))
	  fd (vlax-curve-getfirstderiv (car crv) (vlax-curve-getparamatpoint (car crv) parpt)))
    (vla-AddXline msp (apply 'vlax-3d-point pt) (apply 'vlax-3d-point (mapcar '+ pt fd))))
  
  (vla-EndUndoMark adoc)
  (princ)
  )

[marko_ribar]

Actually, in both codes, it should be :

(setq pt (trans (getpoint "\nSpecify point: ") 1 0))

30 min. rule beat me to mod. my code...

[ВeekeeCZ · Accepted solution]

Good point Marco! 

Although, in my case has to be more than that.

(vl-load-com)

(defun c:parxl ( / *error* acadobj adoc crv msp pt fd )
  
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  
  (setq acadobj (vlax-get-acad-object)
	adoc (vla-get-ActiveDocument acadobj)
	msp (vla-get-ModelSpace adoc)
	)
  (vla-StartUndoMark adoc)
  
  (while (progn
	   (setq crv (entsel "\nSelect curve: "))
	   (cond ((null crv)
		  (princ "\nNothing selected"))
		 ((null (wcmatch (cdr (assoc 0 (entget (car crv)))) "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))
		  (princ "\nObject is not a curve")))))
  
  (while (setq pt (getpoint "\nSpecify point: "))
    (setq fd (vlax-curve-getfirstderiv (car crv)
	       (vlax-curve-getparamatpoint (car crv)
		 (vlax-curve-getclosestpointto (car crv) (trans (cadr crv) 1 0))))
	  pt (trans pt 0 1))
    (vla-AddXline msp (apply 'vlax-3d-point pt) (apply 'vlax-3d-point (mapcar '+ pt fd))))
  
  (vla-EndUndoMark adoc)
  (princ)
  )

[Kent1Cooper · Accepted solution]

Since I had it going before other similar posts, here's another slightly different way, using the first derivative but with (polar) and (angle) functions:

(defun c:parxl (/ *error* acadobj adoc msp crvsel crv perpt pt)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
    )
    (vla-EndUndoMark adoc)
  )
  (setq
    acadobj (vlax-get-acad-object)
    adoc (vla-get-ActiveDocument acadobj)
    msp (vla-get-ModelSpace adoc)
  )
  
  (vla-StartUndoMark adoc)
  (while
    (progn
      (setq crvsel (entsel "\nSelect curve: "))
      (cond
        ((null crvsel) (princ "\nNothing selected"))
        ((null (wcmatch (cdr (assoc 0 (entget (setq crv (car crvsel))))) "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE,XLINE,RAY"))
          (princ "\nObject is not a curve")
        )
      )
    )
  )
  
  (initget 1)
  (setq
    pt (getpoint "\nSpecify point: ")
    perpt (vlax-curve-getclosestpointto crv pt)
  )
  (vla-AddXline msp
    (apply 'vlax-3d-point pt)
    (apply 'vlax-3d-point
      (polar
        pt
        (angle '(0 0) (vlax-curve-getFirstDeriv crv (vlax-curve-getParamAtPoint crv perpt)))
        1
      )
    )
  )
  (vla-EndUndoMark adoc)
  (princ)
)

I added XLINE and RAY to the possible objects to draw parallel to.  But not HELIX, because (polar) and (angle) don't do off-the-current-drawing-plane for a Helix that's not flat.  And I didn't deal with a possible different UCS, but that could be worked in if needed.

[Browning_Zed]

Thank you, guys! All codes work fine.