Automatic drawing arc with trimed line at intersection of two lines

[fixo]

Try this lisp, tested on A2010-2009

(defun C:jmp(/ *error* ang ans bp1 bp2 elist1 elist2 entlist1 entlist2 gap ip osm nom pe1 pe2 ps1 ps2 sellist sset1 sset2 vflag)
  (vl-load-com)
 (defun *error* (msg)
      (vla-endundomark (vla-get-activedocument
              (vlax-get-acad-object))
	      )
    (cond ((or (not msg)
	       (member msg '("console break" "Function cancelled" "quit / exit abort"))
	       )
	   )
	  ((princ (strcat "\nError: " msg)))
	  )
    (setvar "cmdecho" 1)
    (if	osm
      (setvar "osmode" osm)
    )
    (if	nom
      (setvar "osmode" nom)
    )
   
   (setvar "nomutt" 0)
    (princ)
    )
  (vla-startundomark (vla-get-activedocument
              (vlax-get-acad-object))
	      )
  (setq osm(getvar "OSMODE"))
  (setvar "OSMODE" 0)
(princ "\nZoom objects to be visible on screen: ")
(command "_.zoom" "w" pause pause)	 
(setvar "nomutt" 0)
(setq nom (getvar "nomutt"))
	 
(setvar "nomutt" 0)
(princ "\nSelect vertical lines: ")
(setvar "nomutt" 1)
(setq sset1 (ssget ":L" '((0 . "line"))))
(setvar "nomutt" 0)
(princ "\nSelect horizontal lines: ")
(setvar "nomutt" 1)
(setq sset2 (ssget ":L" '((0 . "line"))))
(setvar "nomutt" 0)
(setq *gap* 4);<-- set your gap between lines here
(setq gap (getreal (strcat "\nEnter a gap <" (rtos *gap*) ">: ")))
(cond ((not gap)(setq gap *gap*)))
(setq entlist1 (vl-remove-if 'listp(mapcar 'cadr (ssnamex sset1)))
      entlist2 (vl-remove-if 'listp(mapcar 'cadr (ssnamex sset2))))
 (initget 1 "Vertical Horizontal" )
 (setq ans (getkword "\nChoose lines to be jumped over [Vertical/Horizontal] <H>:"))
(if (eq ans "Vertical")(setq vflag t)(setq vflag nil))
(if vflag (progn
	    ;;swap references to selected objects :
	    (setq sellist (list entlist1 entlist2)
		  entlist2(car sellist)
		  entlist1(cadr sellist))
		
	    (setq ang (/ pi 2))
	    )
  (setq ang 0)
  )
(foreach ent1 entlist1
  (setq elist1 (entget ent1))
  (setq ps1 (cdr (assoc 10 elist1)))
   (setq pe1 (cdr (assoc 11 elist1)))
  (foreach ent2 entlist2
     (setq elist2 (entget ent2))
  (setq ps2 (cdr (assoc 10 elist2)))
    (setq pe2 (cdr (assoc 11 elist2)))
    (setq ip (inters  ps2 pe2 ps1 pe1 nil))
    (setq ip (vlax-curve-getclosestpointto ent1 ip))
    (setq bp1 (polar ip ang (/ gap 2)))
    (setq bp2 (polar ip (+ ang pi) (/ gap 2)))
    
    (command "_.break" bp1 bp2)

      (command "_.arc" bp1 "_E" bp2 "_A" 180.)

    )
)
  (command "_.zoom" "p")
(*error* nil)
  (princ)
  )
(prompt "\n   >>>   Type JMP to execute...")
(prin1)

~'J'~

[pbejse]

Nice idea Oleg.

(defun c:arcit ( / *error* _inters arc objs pts rad dir ang)
(vl-load-com)
(defun  *error* (msg)
(command "._undo" "_end")
(setvar 'osmode old_os) (setvar 'cmdecho cmd1)
)
  
(defun _Inters (ss / en pts ss en pts)
  (repeat (sslength ss)
    (setq en (cons (vlax-ename->vla-object (ssname ss 0)) en))
    (ssdel (ssname ss 0) ss)
  )
  (while en
    (setq pt (car en))
    (mapcar '(lambda (p l / l pt_)
	       (while l (if (setq v (vlax-invoke p
			       'IntersectWith (car l)
			       acExtendNone ))
		   (repeat (/ (length v) 3)
		     (setq pt_ (list (car v) (cadr v) (caddr v))
			   v   (member (nth 3 v) v)
		     )
		     (if (and pt_ (not (vl-position pt_ pts)))
		       (setq pts (cons pt_ pts)))))
		 (setq l (cdr l))))
	    (list pT)
	    (list (setq en (vl-remove pt en)))
    )
  ) pts
)  
(defun Arc (cen rad sAng eAng)
  (entmakex (list (cons 0 "ARC") (cons 10  cen)
                  (cons 40  rad) (cons 50 sAng)
                  (cons 51 eAng))))
   (setq old_os (getvar 'osmode)
         plw   (getvar 'plinewid)
         cmd1  (getvar 'cmdecho)
         clyer (getvar 'clayer))
  
  (setvar 'osmode 0)
  (setvar 'cmdecho 0)
  (command "._undo" "_begin")
  
  (setq objs (ssget ":L" '((0 . "*LINE"))))
  (setq pts (_inters objs))
  (setq rad (if (not rad) 1.0 rad))
  (setq rad (cond
	((getdist (strcat "\nEnter distance"
                 (if rad (strcat " <" (rtos rad) ">: ") ": ")
                            )))(rad)))
  (initget 1 "H V")
  (setq dir (getkword "\nEnter Option:/ Horizontal/Vertical]: "))
  (setq	ang (if	(eq dir "H")
	      '(0 pi)
	      '((/ pi 2.0) (* pi 1.5))
	    )
  )
  (foreach p pts
    (command "_break"
	     (polar p (setq fa (eval (car ang))) rad)
	     (polar p (setq ea (eval (cadr ang))) rad)
    )
    (setq carc (arc p rad fa ea))
  )
  (*error* "")
  (princ)
)

I have yet to modify it to work on different angles.

HTH

[fixo]

Hi bro, it's working like a sharm on my end,
though as always
Regards,

Oleg

[jomzcruz]

cool! thanks marko & pjebse....you make my life easier.