Line to Arc

[Asta]

Line2Arc.lsp

 

Hi Guys

 

I am new to Autocad lisp program.

I have done a Autocad lisp program to convert line to arc.

It will ask vertical line or horizontal line and convert that respective line into arc according to user input radius.

Problem is sometimes it works fine sometime its not.

 

 

Any help will be appreciates.

 

Lisp file is attached

[dlanorh]

Welcome to the Forum.

 

Your lisp is failing on the trim statements, you are passing it a point (p4 or p8) and it is expecting an entity. I don't understand what you are trying to achieve with using trim.

[Jonathan Handojo]

@dlanorh Nah, not really... he did:

 

(if (= "h" vh)
    ((setq p1 (polar ctr (dtr 0.0) r))
      (setq p2 (polar ctr (dtr 180.0) r))
      (setq p4 (polar ctr (dtr 0.0) (- 1 r)))
      (command "_Arc" "_C" ctr p1 p2)
      (setq p3 (ssget "X" '((0 . "Arc"))))
      (command "trim" p3 "" p4 ""))
    
    ((setq p5 (polar ctr (dtr 90.0) r))
      (setq p6 (polar ctr (dtr 270.0) r))
      (setq p8 (polar ctr (dtr 270.0) (- 1 r)))
      (command "_Arc" "_C" ctr p5 p6)
      (setq p7 (ssget "X" '((0 . "Arc"))))
      (command "trim" p7 "" p8 "")))

 

You don't bracket a group of statements if you want to run multiple expression like the above. You're simply missing one word:

 

(if (= "h" vh)
    (progn (setq p1 (polar ctr (dtr 0.0) r))
      (setq p2 (polar ctr (dtr 180.0) r))
      (setq p4 (polar ctr (dtr 0.0) (- 1 r)))
      (command "_Arc" "_C" ctr p1 p2)
      (setq p3 (ssget "X" '((0 . "Arc"))))
      (command "trim" p3 "" p4 ""))
    
    (progn (setq p5 (polar ctr (dtr 90.0) r))
      (setq p6 (polar ctr (dtr 270.0) r))
      (setq p8 (polar ctr (dtr 270.0) (- 1 r)))
      (command "_Arc" "_C" ctr p5 p6)
      (setq p7 (ssget "X" '((0 . "Arc"))))
      (command "trim" p7 "" p8 "")))

 

Oh, btw... I've simplified your code as such:

 

(defun c:linearc ( / horver cent rad)
  (setq horver (progn (initget 1 "Horizontal Vertical") (getkword "\nHorizontal or Vertical? [Horizontal/Vertical]: "))
	cent (progn (initget 1) (getpoint "\nSpecify center of arc: "))
	rad (progn (initget 1) (getdist cent "\nSpecify radius: "))
	)
  (entmake
    (list
      '(0 . "ARC")
      (cons 10 cent)
      (cons 40 rad)
      (cons 50 (if (eq horver "Horizontal") 0 (* 0.5 pi)))
      (cons 51 (if (eq horver "Horizontal") pi (* 1.5 pi)))
      )
    )
  (princ)
  )

 

[Asta]

@Jonathan Handojo Thanks for the simplified program. It works fine but the result of your program is like as shown below

 

 

But i need result as below image. For this only i used trim command @dlanorh

 

 

 

[Jonathan Handojo]

I didn't thought you'd be doing that. I simply thought it was just an arc.

 

A better way to approach that is if you select all lines or curves) that "goes below" (or doesn't change), then select the one polyline to curve or "go above" as shown in your desired result.

 

With the help of LM:intersectionbetweensets by Lee Mac, this can be accomplished as shown in the gif below

 

 

Assuming that the "purple" lines doesn't go too close the vertex of the polyline to "go above", the code to do as such is below:

 

;; Intersections Between Sets  -  Lee Mac
;; Returns a list of all points of intersection between objects in two selection sets.
;; ss1,ss2 - [sel] Selection sets

(defun LM:intersectionsbetweensets ( ss1 ss2 / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength ss1))
        (setq ob1 (vlax-ename->vla-object (ssname ss1 (setq id1 (1- id1)))))
        (repeat (setq id2 (sslength ss2))
            (setq ob2 (vlax-ename->vla-object (ssname ss2 (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)

;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

(defun c:linearc ( / *error* above activeundo acadobj adoc ang arc below msp rad)
  (defun *error* ( msg )
    (setvar "CMDECHO" cmd)
    (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)
	activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))
  
  (princ "\nSelect curves that goes below: ")
  (if (setq cmd (getvar "CMDECHO")
	    below (ssget '((0 . "LINE,*POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE")))
	    )
    (progn
      (setq rad (progn (initget 1) (getreal "\nSpecify radius of arc: ")))
      (while
	(progn
	  (setq above (entsel "\nSelect curve that goes above: "))
	  (cond
	    ((null above) (princ "\nNothing selected"))
	    ((not (wcmatch (cdr (assoc 0 (entget (car above)))) "LINE,*POLYLINE,CIRCLE,ARC,ELLIPSE,SPLINE"))
	     (princ "\nObject is not a curve")
	     )
	    ((setq above (car above)) nil)
	    )
	  )
	)

      (setvar "CMDECHO" 0)
      (foreach x
	       (vl-sort
		 (LM:intersectionsbetweensets below (ssadd above))
		 '(lambda (a b)
		    (<
		      (vlax-curve-getParamAtPoint above a)
		      (vlax-curve-getParamAtPoint above b)
		      )
		    )
		 )
	(if
	  (<
	    (* 0.5 pi)
	    (setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv above (vlax-curve-getParamAtPoint above x))))
	    (* 1.5 pi)
	    )
	  (setq ang (+ pi ang))
	  )
	(setq arc
	       (entmakex
		 (list
		   '(0 . "ARC")
		   (cons 10 x)
		   (cons 40 rad)
		   (cons 50 ang)
		   (cons 51 (+ pi ang))
		   )
		 )
	      )
	(command "_break" above (polar x ang rad) (polar x (+ pi ang) rad))
	(setq above (entnext arc))
	)
      (setvar "CMDECHO" cmd)
      )
    )
  
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

The arc is drawn under the assumption that the intersection point is a straight line, and thus the angle between the arc is 180. If you were to select it on a circle, you'll notice that the arc and line won't be in line, but I think this will be quite enough with what you need to achieve.

 

Thanks,

Jonathan Handojo

[ronjonp]

Another one here.  It's single pick but will keep the polyline intact.

[Asta]

Thanks a lot @Jonathan Handojo it works how i expect.