Add to this lisp

[cadman_meg]

Could someone please add the functionality of picking which side of the primary line to add the arc? It also creates a circle for some reason rather than an arc like it should, maybe you could fix that as well please. When finished you could email it to me at . I really appreciate the help. Here is the routine:

(defun CLBREAK2 (/ CMDE CNT ENAM1 ENAM2 EOBJ1 EOBJ2 PTLST PTLST2 SSETC SSETL)  (initget 7)  (setq RAD (getdist "\nEnter hump radius: "))  (while (not (setq ESEL1 (entsel "\nSelect primary line: ")))   (princ "\nNull selection, please select again: ") &nbsp  (while (not (setq ESEL2 (entsel "\nSelect line to be broken: ")))   (princ "\nNull selection, please select again: ") &nbsp  (setq ENAM1 (car ESEL1)        EOBJ1 (vlax-ename->vla-object ENAM1)        ENAM2 (car ESEL2)        EOBJ2 (vlax-ename->vla-object ENAM2)        PTLST (vlax-safearray->list               (variant-value                (vla-intersectwith EOBJ1 EOBJ2 0)              &nbsp             &nbsp        CNT 0 &nbsp  (setq PTLST (point_list PTLST))  (vla-put-visible EOBJ1 :vlax-false)  (setq ENAM4 (entlast))  (setq CMDE (getvar "cmdecho"))  (setvar "cmdecho" 0)  (foreach N PTLST   (print N)   (vl-cmdf "circle" N RAD)   (setq ENAM3 (entlast))   (if SSETC    (setq SSETC (ssadd ENAM3 SSETC))    (setq SSETC (ssadd ENAM3))  &nbsp   (vl-cmdf "trim" ENAM3 "" N "")
&nbsp

(while (setq ENAM4 (entnext ENAM4))
  (if SSETL
   (setq SSETL (ssadd ENAM4 SSETL))
   (setq SSETL (ssadd ENAM4))
 &nbsp
&nbsp
 (setq CNT 0)
 (repeat (sslength SSETC)
  (setq ENAM (ssname SSETC CNT)
        CNT (1+ CNT)         EOBJ (vlax-ename->vla-object ENAM)         TPTS (point_list               (vlax-safearray->list                (variant-value                 (vla-intersectwith EOBJ EOBJ1 0)               &nbsp              &nbsp             &nbsp
 &nbsp

(vl-cmdf "trim" SSETL ""
   (if (< (distance (car TPTS) (list 0.0 0.0 0.0))           (distance (cadr TPTS) (list 0.0 0.0 0.0))       &nbsp     (car TPTS)     (cadr TPTS)   &nbsp    ""  &nbsp &nbsp  (vla-put-visible EOBJ1 :vlax-true)  (vl-cmdf "pedit" (ssname SSETC 0) "Y" "J" SSETC SSETL "" "")  (setvar "cmdecho" CMDE) ) ; This routine converts coordinate list into a list of points (defun POINT_LIST (PTLST / CNT PTLST2)  (setq CNT 0)  (repeat (/ (length PTLST) 3)   (setq PTLST2 (cons (list                       (nth (+ 0 (* CNT 3)) PTLST)                       (nth (+ 1 (* CNT 3)) PTLST)                       (nth (+ 2 (* CNT 3)) PTLST)                     &nbsp                      PTLST2               &nbsp         CNT (1+ CNT)  &nbsp &nbsp  PTLST2 )

 

[cadman_meg]

Anyone have any ideas on this one? Would be much appreciated. TIA.

 

[Jim Claypool]

I don't have time to figure out all of what is wrong with this, but if you want to take a different approach,

here is one that I use.

 

(defun clbreak2
 (setq osmode (getvar "osmode"))
 (setq clayer (getvar "clayer"))
 (setvar "osmode" 512)
 (setq rad (getdist "\nEnter hump radius: "))
 (setq entpt (getpoint "\nSelect line to break: "))  (setq ename (ssname (ssget "c" entpt entpt) 0))  (if   (or    (= (cdr (assoc 0 (entget ename))) "LWPOLYLINE")    (= (cdr (assoc 0 (entget ename))) "POLYLINE")   )   (progn    (setvar "clayer" (cdr (assoc 8 (entget ename))))    (get_end_points (entget ename))    ;(setq ang (angle firstpt lastpt))    (redraw ename 3)    (setvar "osmode" 32)    (setq pt (getpoint "\nSelect Intersection "))    (setvar "osmode" 0)    (setq ang (angle entpt pt))    (setq pt1 (polar pt (+ pi ang) rad))    (setq pt2 (polar pt1 ang (* rad 2.0)))    (setq arcdist (/ (distance pt1 pt2) 1.9))    (redraw ename 4)    (command "break" ename pt1 pt2)    (setq new_ename (entlast))    (setvar "osmode" 1)    (command ".pline" pt1 "a" "r" arcdist pt2 "")    (setq arcname (entlast))    (command ".pedit" ename "j" (entlast) new_ename "" "")   );end progn   (progn    (alert "Object selected is not a polyline")    (exit)   );end progn  end if  (setvar "osmode" osmode)  (setvar "clayer" clayer)
)

 

"cadman_meg" <> wrote:

Could someone please add the functionality of picking which side of the primary line to add the arc? It also creates a circle for some reason rather than an arc like it should, maybe you could fix that as well please. When finished you could email it to me at . I really appreciate the help. Here is the routine:

(defun CLBREAK2 (/ CMDE CNT ENAM1 ENAM2 EOBJ1 EOBJ2 PTLST PTLST2 SSETC SSETL)  (initget 7)  (setq RAD (getdist "\nEnter hump radius: "))  (while (not (setq ESEL1 (entsel "\nSelect primary line: ")))   (princ "\nNull selection, please select again: ") &nbsp  (while (not (setq ESEL2 (entsel "\nSelect line to be broken: ")))   (princ "\nNull selection, please select again: ") &nbsp  (setq ENAM1 (car ESEL1)        EOBJ1 (vlax-ename->vla-object ENAM1)        ENAM2 (car ESEL2)        EOBJ2 (vlax-ename->vla-object ENAM2)        PTLST (vlax-safearray->list               (variant-value                (vla-intersectwith EOBJ1 EOBJ2 0)              &nbsp             &nbsp        CNT 0 &nbsp  (setq PTLST (point_list PTLST))  (vla-put-visible EOBJ1 :vlax-false)  (setq ENAM4 (entlast))  (setq CMDE (getvar "cmdecho"))  (setvar "cmdecho" 0)  (foreach N PTLST   (print N)   (vl-cmdf "circle" N RAD)   (setq ENAM3 (entlast))   (if SSETC    (setq SSETC (ssadd ENAM3 SSETC))    (setq SSETC (ssadd ENAM3))  &nbsp   (vl-cmdf "trim" ENAM3 "" N "")
&nbsp

(while (setq ENAM4 (entnext ENAM4))
  (if SSETL
   (setq SSETL (ssadd ENAM4 SSETL))
   (setq SSETL (ssadd ENAM4))
 &nbsp
&nbsp
 (setq CNT 0)
 (repeat (sslength SSETC)
  (setq ENAM (ssname SSETC CNT)
        CNT (1+ CNT)         EOBJ (vlax-ename->vla-object ENAM)         TPTS (point_list               (vlax-safearray->list                (variant-value                 (vla-intersectwith EOBJ EOBJ1 0)               &nbsp              &nbsp             &nbsp
 &nbsp

(vl-cmdf "trim" SSETL ""
   (if (< (distance (car TPTS) (list 0.0 0.0 0.0))           (distance (cadr TPTS) (list 0.0 0.0 0.0))       &nbsp     (car TPTS)     (cadr TPTS)   &nbsp    ""  &nbsp &nbsp  (vla-put-visible EOBJ1 :vlax-true)  (vl-cmdf "pedit" (ssname SSETC 0) "Y" "J" SSETC SSETL "" "")  (setvar "cmdecho" CMDE) ) ; This routine converts coordinate list into a list of points (defun POINT_LIST (PTLST / CNT PTLST2)  (setq CNT 0)  (repeat (/ (length PTLST) 3)   (setq PTLST2 (cons (list                       (nth (+ 0 (* CNT 3)) PTLST)                       (nth (+ 1 (* CNT 3)) PTLST)                       (nth (+ 2 (* CNT 3)) PTLST)                     &nbsp                      PTLST2               &nbsp         CNT (1+ CNT)  &nbsp &nbsp  PTLST2 )

 

[Mark Godfrey]

This doesn't seem top work properly and from what I see, it would only work on polylines and not just regular lines as well.

"Jim Claypool" <> wrote:

I don't have time to figure out all of what is wrong with this, but if you want to take a different approach,

here is one that I use.

 

(defun clbreak2
 (setq osmode (getvar "osmode"))
 (setq clayer (getvar "clayer"))
 (setvar "osmode" 512)
 (setq rad (getdist "\nEnter hump radius: "))
 (setq entpt (getpoint "\nSelect line to break: "))  (setq ename (ssname (ssget "c" entpt entpt) 0))  (if   (or    (= (cdr (assoc 0 (entget ename))) "LWPOLYLINE")    (= (cdr (assoc 0 (entget ename))) "POLYLINE")   )   (progn    (setvar "clayer" (cdr (assoc 8 (entget ename))))    (get_end_points (entget ename))    ;(setq ang (angle firstpt lastpt))    (redraw ename 3)    (setvar "osmode" 32)    (setq pt (getpoint "\nSelect Intersection "))    (setvar "osmode" 0)    (setq ang (angle entpt pt))    (setq pt1 (polar pt (+ pi ang) rad))    (setq pt2 (polar pt1 ang (* rad 2.0)))    (setq arcdist (/ (distance pt1 pt2) 1.9))    (redraw ename 4)    (command "break" ename pt1 pt2)    (setq new_ename (entlast))    (setvar "osmode" 1)    (command ".pline" pt1 "a" "r" arcdist pt2 "")    (setq arcname (entlast))    (command ".pedit" ename "j" (entlast) new_ename "" "")   );end progn   (progn    (alert "Object selected is not a polyline")    (exit)   );end progn  end if  (setvar "osmode" osmode)  (setvar "clayer" clayer)
)

 

"cadman_meg" <> wrote:

Could someone please add the functionality of picking which side of the primary line to add the arc? It also creates a circle for some reason rather than an arc like it should, maybe you could fix that as well please. When finished you could email it to me at . I really appreciate the help. Here is the routine:

(defun CLBREAK2 (/ CMDE CNT ENAM1 ENAM2 EOBJ1 EOBJ2 PTLST PTLST2 SSETC SSETL)  (initget 7)  (setq RAD (getdist "\nEnter hump radius: "))  (while (not (setq ESEL1 (entsel "\nSelect primary line: ")))   (princ "\nNull selection, please select again: ") &nbsp  (while (not (setq ESEL2 (entsel "\nSelect line to be broken: ")))   (princ "\nNull selection, please select again: ") &nbsp  (setq ENAM1 (car ESEL1)        EOBJ1 (vlax-ename->vla-object ENAM1)        ENAM2 (car ESEL2)        EOBJ2 (vlax-ename->vla-object ENAM2)        PTLST (vlax-safearray->list               (variant-value                (vla-intersectwith EOBJ1 EOBJ2 0)              &nbsp             &nbsp        CNT 0 &nbsp  (setq PTLST (point_list PTLST))  (vla-put-visible EOBJ1 :vlax-false)  (setq ENAM4 (entlast))  (setq CMDE (getvar "cmdecho"))  (setvar "cmdecho" 0)  (foreach N PTLST   (print N)   (vl-cmdf "circle" N RAD)   (setq ENAM3 (entlast))   (if SSETC    (setq SSETC (ssadd ENAM3 SSETC))    (setq SSETC (ssadd ENAM3))  &nbsp   (vl-cmdf "trim" ENAM3 "" N "")
&nbsp

(while (setq ENAM4 (entnext ENAM4))
  (if SSETL
   (setq SSETL (ssadd ENAM4 SSETL))
   (setq SSETL (ssadd ENAM4))
 &nbsp
&nbsp
 (setq CNT 0)
 (repeat (sslength SSETC)
  (setq ENAM (ssname SSETC CNT)
        CNT (1+ CNT)         EOBJ (vlax-ename->vla-object ENAM)         TPTS (point_list               (vlax-safearray->list                (variant-value                 (vla-intersectwith EOBJ EOBJ1 0)               &nbsp              &nbsp             &nbsp
 &nbsp

(vl-cmdf "trim" SSETL ""
   (if (< (distance (car TPTS) (list 0.0 0.0 0.0))           (distance (cadr TPTS) (list 0.0 0.0 0.0))       &nbsp     (car TPTS)     (cadr TPTS)   &nbsp    ""  &nbsp &nbsp  (vla-put-visible EOBJ1 :vlax-true)  (vl-cmdf "pedit" (ssname SSETC 0) "Y" "J" SSETC SSETL "" "")  (setvar "cmdecho" CMDE) ) ; This routine converts coordinate list into a list of points (defun POINT_LIST (PTLST / CNT PTLST2)  (setq CNT 0)  (repeat (/ (length PTLST) 3)   (setq PTLST2 (cons (list                       (nth (+ 0 (* CNT 3)) PTLST)                       (nth (+ 1 (* CNT 3)) PTLST)                       (nth (+ 2 (* CNT 3)) PTLST)                     &nbsp                      PTLST2               &nbsp         CNT (1+ CNT)  &nbsp &nbsp  PTLST2 )