Leaderboard

Save it as a global variable: ( (defun c:test () (setq *your_global_variable* (cond ((getdist (strcat "\nSpecify distance" (if *your_global_variable* (strcat " <" (rtos *your_global_variable* 2 3) ">") "") ": "))) (*your_global_variable*) ) ) )

Oh that worked perfect, many thanks!

Looking at the block, probably AttSync will work. Sometimes this won't work if you have changed the attributes in a block in the Enhanced Attribute Editor, AttSync will reset them to the default, so try below. For example, Sometimes with title blocks if the freetexts - drawing title or description can extend out of the area assigned and you change the width factor perhaps - attsync will reset that (as a example) (defun c:MoveBlocks ( / target-point block-name) (setq target-point '(300.0 5.25 0.0)) ;;Point to move to (setq block-name "RegionserviceUTR") ;;Block Name to move (MoveBlock target-point block-name) ) (defun MoveBlock (target-point block-name / BlockSS acount) (setq BlockSS (ssget "_X" (list '(0 . "INSERT")(cons 2 block-name)))) (setq acount 0) (while (< acount (sslength BlockSS)) (entmod (subst (cons 10 target-point) (assoc 10 (entget (ssname BlockSS acount))) (entget (ssname BlockSS acount)) )) (setq acount (+ acount 1)) ) ; end while (command "attsync" "N" block-name) )

i once needed something similar, i found a function somewhere online that does that and modified it somewhat to my needs. Its still somewhat clumpy but maybe it helps.. (defun c:divarea (/ *error* osmode cmdecho blipmode correctent-p ready fixpt parpt answer ename divider area) (defun *error* (msg) (if osmode (setvar "osmode" osmode)) (if cmdecho (setvar "cmdecho" cmdecho)) (if blipmode (setvar "blipmode" blipmode)) (princ (strcat "\nError: " msg)) (princ) ) (defun correctent-p (ent /) (if ent (and (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE") (= (cdr (assoc 70 (entget ent))) 1) ) nil ) );defun (defun ready () (setvar "osmode" osmode) (setvar "cmdecho" cmdecho) (setvar "blipmode" blipmode) (princ (strcat "\nFull Area : " (rtos area))) (princ (strcat "\nNew Area : " (rtos newarea))) (princ) );defun (defun initiate-parpt (newarea i / parpt getcenter divisionline boundarypoint oldline ptb temp newboundary pt1) (defun parpt (tem line pts / p1 p2 precision deln pts par linedata) (setvar "osmode" osmode) (setq precision (/ (vla-get-length (vlax-ename->vla-object line)) 10)) (setvar "osmode" 0) (command "_line" p1 p2 "") (setq deln (entlast)) ;put line to delete later (if (not ptb) (setq ptb (getpoint "\nPick any point into the REST of the piece, FAR from division line: "))) (setvar "blipmode" 0) (princ "\nPlease wait...") (command "_boundary" pts "") (setq newboundary (entlast)) (setq par (vla-get-area (vlax-ename->vla-object newboundary))) ;par = area created by boundary (while (> (abs (- par tem)) 0.00001) (if (< par tem) (progn (while (< par tem) (entdel newboundary) ;delete boundary (command "_offset" precision deln ptb "") (entdel deln) (setq deln (entlast)) (command "_boundary" pts "") (setq newboundary (entlast)) (setq par (vla-get-area (vlax-ename->vla-object newboundary))) ) ) (progn (while (> par tem) (entdel newboundary) (command "_offset" precision deln pts "") (entdel deln) (setq deln (entlast)) (command "_boundary" pts "") (setq newboundary (entlast)) (setq par (vla-get-area (vlax-ename->vla-object newboundary))) ) ) ) (setq linedata (entget deln)) (entdel deln) (setq precision (/ precision 1.5)) (princ precision) ) (command "_change" newboundary "" "_p" "_c" "_green" "") linedata );defun (defun getcenter (line1 line2 / p1 p2) (setq p1 (cdr (assoc 10 (entget line1)))) (setq p2 (cdr (assoc 11 (entget line2)))) (list (/ (+ (car p1) (car p2)) 2) ; x-coordinate of the center point (/ (+ (cadr p1) (cadr p2)) 2) ; y-coordinate of the center point ) );defun (command "_line" (setq pt1 (getpoint "\nPick one point of division line (far from lwpoly) : ")) (getpoint pt1 "\nPick other point of division line (far from lwpoly) : ") "" ) (setq divisionline (entlast)) (setq boundarypoint (getpoint "\nPick any point into FIRST piece, FAR from division line: ")) (setq temp (parpt newarea divisionline boundarypoint)) (while (> i 2) (entmake temp) (setq oldline (entlast)) (command "_offset" (/ (vla-get-length (vlax-ename->vla-object oldline)) 200) oldline ptb "") (setq divisionline (entlast)) (setq boundarypoint (getcenter oldline divisionline)) (entdel oldline) (setq temp (parpt newarea divisionline boundarypoint)) (setq i (1- i)) ) (command "_boundary" ptb "") (setq newboundary (entlast)) (command "_change" newboundary "" "_p" "_c" "_green" "") );defun (setq osmode (getvar "osmode") cmdecho (getvar "cmdecho") blipmode (getvar "blipmode") ) (setvar "osmode" 0) (setvar "cmdecho" 0) (while (not (correctent-p ename)) (setq ename (car (entsel "\nSelect closed LWPOLY to divide: "))) ) (setq area (vla-get-area (vlax-ename->vla-object ename))) (initget "Divide Cut") (setq answer (cond ((getkword "\nDIVIDE by number or CUT a part ? [Divide/Cut] <Divide>: ")) ("Divide"))) (if (= answer "Divide") (progn (setq divider (cond ((getreal "\nEnter number to divide the whole part by <2>: ")) (2))) (setq newarea (/ area divider)) ) (setq newarea (getreal "\nArea to cut : ")) ) (initiate-parpt newarea divider) (ready) )

This was something that I also challenged myself to do. Though not perfect, the purpose of this program was to "neaten" Revit exported or similar pipelines so that they are all "filleted" and "trimmed" cleanly so that it works with my other commands that I've created. I don't know how useful this will be, but if it doesn't suit your requirements, I'll give another crack at it. You will probably just have to select the lines separately (the yellow and green lines). Neaten.lsp

I think this is the next step, it isn't pretty though but I need to go to the supermarket. Select 1 segment in the arc. Might fail if the arc doesn't have a straight line either side of it and a few other errors. not tested fully and needs be tidied up with some notes added. Try it and see. Step after this is to do this for all the drawing and not one arc at a time (defun c:ConnectedLines ( / StopLoop MySS MyList MyLines acount pt pt1 pt2 pt3 pt4 LineSS ConnectedLines) ;;Sub Functions (defun onlyunique ( MyList / returnList ) (setq ReturnList (list)) ; blank list for result (foreach n MyList ; loop through supplied list (if ( = (member n (cdr (member n MyList))) nil) ; if list item occurs only once (setq ReturnList (append ReturnList (list n))) ; add to list ) ) ; end foreach ReturnList ) (defun uniquepoints ( MySS / MyList acount) (princ "Select Lines") (setq MyList (list)) ; Blank list for line coordinates (setq acount 0) (while (< acount (sslength MySS)) ; loop each line (setq MyEnt (entget (ssname MySS acount))) (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list (setq acount (+ acount 1)) ) (list (onlyunique MyList) MyList) ; list: Unique Items, All Items ) ;; 3-Point Circle - Lee Mac ;; Returns the center (UCS) and radius of the circle defined by three supplied points (UCS). ;; Modified to return only radius (defun 3PR (pt1 pt2 pt3 / cen md1 md2 vc1 vc2) (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3) vc1 (mapcar '- pt2 pt1) vc2 (mapcar '- pt3 pt2) cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0)) md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0)) nil ) ) (distance cen pt1) ) ) (defun mid-pt ( p1 p2 / ) (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.) ) ) (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 DrawLine (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2) ))) ;;End sub functions (setq MyEnt (car (entsel "Select a line"))) ; A selected line (setq ConnectedLines (ssadd MyEnt)) ; List for lines connected to selected (setq MyList (ssadd MyEnt)) ; List for used lines ; Later: for selection set selections (setq Pt (cdr (assoc 10 (entget MyEnt)))) ; End A point (setq Pt2 (cdr (assoc 11 (entget MyEnt)))) ; End A point (setq AnEnt MyEnt) ; Starting Entity ;;Get initial intersection (setq LineSS (ssadd)) ; Empty Selection Set (setq MidPt (mid-pt Pt Pt2)) (setq MyAng (angle Pt Pt2)) (setq Pt3 (polar MidPt (- MyAng (/ pi 2)) 1000)) (setq LineSS (ssadd (DrawLine MidPt Pt3) LineSS )) (setq Pt1 (mapcar '+ '(-0.0001 -0.0001) Pt)); Small area around end of line (setq Pt3 (mapcar '+ '( 0.0001 0.0001) Pt)); Other corner (setq MySS (ssget "_C" Pt1 Pt3 '((0 . "LINE"))) ) ; select joining lines within 0.0001 (if (= (sslength MySS) 1) ; If only 1 joining lines (progn (setq Pt1 (mapcar '+ '(-0.0001 -0.0001) Pt2)); Small area around end of line (setq Pt3 (mapcar '+ '( 0.0001 0.0001) Pt2)); Other corner (setq MySS (ssget "_C" Pt1 Pt3 '((0 . "LINE"))) ) ; select joining lines within 0.0001 ) ) (if (= (sslength MySS) 2) ; If 2 joining lines (progn (setq AnEnt (ssname (ssdel AnEnt MySS) 0)) (setq APtA (cdr (assoc 10 (entget AnEnt)))) ; next line end points (setq APtB (cdr (assoc 11 (entget AnEnt)))) (setq MidPt (mid-pt APtA APtB)) (setq MyAng (angle APtA APtB)) (setq Pt3 (polar MidPt (- MyAng (/ pi 2)) 1000)) (setq LineSS (ssadd (DrawLine MidPt Pt3) LineSS )) ) ) (setq Int1 (LM:intersections (vlax-ename->vla-object (ssname LineSS 0)) (vlax-ename->vla-object (ssname LineSS 1)) acextendboth)) (setq MyRadius (distance (car Int1) APtA)) ;;Reset points (setq Pt (cdr (assoc 10 (entget MyEnt)))) ; End A point (setq Pt2 (cdr (assoc 11 (entget MyEnt)))) ; End B point (setq AnEnt MyEnt) ; Starting Entity (setq EndLines (ssadd)) (repeat 2 ; Repeat2 - both directions (setq StopLoop "No") ; Marker to stop looping (while (= StopLoop "No") (setq Pt1 (mapcar '+ '(-0.0001 -0.0001) Pt)); Small area around end of line (setq Pt3 (mapcar '+ '( 0.0001 0.0001) Pt)); Other corner (setq MySS (ssget "_C" Pt1 Pt3 '((0 . "LINE"))) ) ; select joining lines within 0.0001 (if (= (sslength MySS) 2) ; If only 2 joining lines (progn (setq MySS (ssdel AnEnt MySS)) ; Next line (setq AnEnt (ssname MySS 0)) ; next line entity name (setq APtA (cdr (assoc 10 (entget AnEnt)))) ; next line end points (setq APtB (cdr (assoc 11 (entget AnEnt)))) (if (ssmemb AnEnt MyList) (progn (princ "Repeating Selection") (setq StopLoop "Yes") ) (progn (setq MyList (ssadd MyEnt)) ; List for used lines ; Later: for selection set selections ;;get intersection (setq MidPt (mid-pt APtA APtB)) (setq MyAng (angle APtA APtB)) (setq Pt3 (polar MidPt (- MyAng (/ pi 2)) 1000)) (setq LineSS (ssadd (setq TempLine (DrawLine MidPt Pt3)) LineSS )) (setq Int2 (LM:intersections (vlax-ename->vla-object (ssname LineSS 0)) (vlax-ename->vla-object TempLine) acextendboth)) (if (equal Int1 Int2 0.01) ; intersection point the same (progn (setq ConnectedLines (ssadd AnEnt ConnectedLines)) ; add next line to list of connected lines ) (progn (setq EndLines (ssadd AnEnt EndLines)) (setq StopLoop "Yes") ) ) (if (equal APtA Pt 0.0001) (setq Pt APtB)(setq Pt APtA) ; work out if next line connected at end A or B ) ) ) ) ; end progn (progn (setq StopLoop "Yes") ) ; end progn ) ; end if SSlength = 2 ) ; end while stoploop (setq Pt (cdr (assoc 11 (entget MyEnt)))) (setq AnEnt MyEnt) ) ; end repeat (command "erase" LineSS "") ; delete temporary lines (if (< 2 (sslength ConnectedLines)) (progn (setq MyList (uniquepoints ConnectedLines));; SP ADDED (setq p1 (car (car MyList)));; SP ADDED (setq p2 (nth (/ (length (cadr MyList)) 2) (cadr MyList)));; SP ADDED (setq p3 (cadr (car MyList)));; SP ADDED ;;Do something here error checking or so no fillet needed: Lee Mac 3 point Arcs (setq line1 (ssname EndLines 0)) (setq line2 (ssname EndLines 1)) ; (setq line1 (car (entsel "Select line"))) ; (setq line2 (car (entsel "Select line"))) (setq FilletRad_Old (getvar 'filletrad)) (setvar 'filletrad MyRadius) (setvar 'filletrad (3PR p1 p2 p3)) (command "fillet" line1 line2) (setvar 'filletrad FilletRad_OLd) (command "erase" ConnectedLines "") ) ; end progn ) ; end if ; (ssdel ConnectedLines) )

Check the radius setting for the FILLET command. It needs to be zero if you want a sharp corner. If that doesn't help, please provide more information.

A better idea is to work out by calculating the perpendicular bisectors of the line segments. Take 3 consecutive lines and calculate the point where the perpendicular bisector intersects. The point where the perpendicular bisectors meet is the centre of the arc, so if they are within close proximity (to a certain tolerance), then this entails an arc segment. Otherwise, it's not.

unfortunately I have moved on from CAD and am now using exclusively solidworks at my job. so i don't get to dabble in lisp as much as i use to. Here is another manual proof. Make a 3 point arc use newly created entity's bounding box delete lines that are selected with the lower left and upper right points. ;;----------------------------------------------------------------------------;; ;; Lines to Arc ;; https://www.cadtutor.net/forum/topic/80056-i-want-to-convert-many-straight-lines-into-one-arc/ (defun c:MSLIOA (/ LL UR) ;Many Stright Lines Into One Arc (command "Arc" pause pause pause) ;wait for user to pick points. (vla-getboundingbox (vlax-ename->vla-object (entlast)) 'minpt 'maxpt) (setq LL (vlax-safearray->list minpt) UR (vlax-safearray->list maxpt)) (command "_.Erase" (ssget "_W" LL UR '((0 . "LINE"))) "") )

Tip - I like to set ucsfollow to '1' so it automatically rotates the view in model space when you change the ucs via views on the ribbon. This is helpful when rotating the ucs to unusual angles.