Leaderboard

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) )

I don't know if I understood everything! But like this, can it be suitable? (vl-load-com) (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o) (setq n (/ (cadr (getvar "screensize")) 5.0)) (setq pt (osnap pt-i str-md)) (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o)) (repeat 2 (setq rap (/ (getvar "viewsize") n) pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt5 (list (car pt) (- (cadr pt) rap) (caddr pt)) pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt)) pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt)) pt8 (list (- (car pt) rap) (cadr pt) (caddr pt)) pt56 (polar pt (- (/ pi 4.0)) rap) pt67 (polar pt (/ pi 4.0) rap) pt78 (polar pt (- pi (/ pi 4.0)) rap) pt85 (polar pt (+ pi (/ pi 4.0)) rap) n (- n 16) ) (if (equal (osnap pt-i md) pt) (setq one_o T)) (cond ((and (eq "_end" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1) ) ((and (eq "_mid" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1) ) ((and (eq "_cen" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt5 pt7 7) (grdraw pt6 pt8 7) ) ((and (eq "_nod" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_qua" md) one_o) (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1) ) ((and (eq "_int" md) one_o) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_ins" md) one_o) (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1) ) ((and (eq "_per" md) one_o) (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1) ) ((and (eq "_tan" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt3 pt4 1) ) ((and (eq "_nea" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1) ) ) ) (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0)) ) ) (defun nentsel-getreal ( / o mod ent key n nbr) (setq o (getvar "osmode")) (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192) '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par") ) ) ) (setq nbr "") (princ (strcat "\nSpecify a point at [" mod "] of, or choose Text/Multiline Text/Attribute to get Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: ")) (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (mapcar '(lambda (p1 p2) (grdraw (trans p1 0 1) (trans p2 0 1) 7)) lst_tmp (cdr lst_tmp)) (if (and (/= mod "_none") (osnap (cadr key) mod)) (progn (gr-osmode (cadr key) mod) (repeat 128 (princ "\010")) (princ (caddr (osnap (cadr key) mod)))) ) ) ((eq (car key) 2) (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57)) (if (eq (cadr key) 8) (progn (princ (chr 8)) (princ (chr 32)) (princ (chr 8)) (setq nbr (substr nbr 1 (1- (strlen nbr)))) ) (progn (setq n (chr (cadr key))) (princ n) (setq nbr (strcat nbr n)) ) ) ) ) ) ) (if (eq (car key) 3) (if (setq ent (nentselp (cadr key))) (progn (setq ent (entget (car ent))) (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB")) (progn (setq ent (read (cdr (assoc 1 ent)))) (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL)) (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent) (progn (princ "\nInvalid text!") (nentsel-getreal)) ) ) (progn (setq nbr "") (if (osnap (cadr key) mod) (setvar "LASTPOINT" (osnap (cadr key) mod)) (nentsel-getreal) ) (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT")) 2 2))) (caddr (getvar "LASTPOINT")) ) ) ) (progn (princ "\nEmpty selection!") (setq ent nil) (nentsel-getreal)) ) (if (/= nbr "") (progn (princ (strcat "\nZ = " nbr)) (atof nbr)) (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT"))) ) ) ) (defun c:Test ( / pt1 pt2 height radius dxf_210 center textChoices selectedIndex selectedText) (initget 9) (setq pt1 (getpoint "\nEnter first point of circle's diameter: ")) (initget 9) (setq pt2 (getpoint pt1 "\nEnter second point of circle's diameter: ")) (setvar "PDMODE" 2) (setvar "PDSIZE" 0.05) (setq height (nentsel-getreal)) (setq radius (* (distance pt1 pt2) 0.5)) (setq dxf_210 (trans '(0 0 1) 1 0 T)) (setq pt1 (list (car pt1) (cadr pt1) height)) (setq pt2 (list (car pt2) (cadr pt2) height)) (setq center (trans (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) 1 dxf_210)) (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") (cons 8 "Test") (cons 40 radius) (cons 10 center) (cons 210 dxf_210) ) ) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") '(100 . "AcDbPoint") (cons 8 "Test") (cons 10 (trans center dxf_210 0)) (cons 50 (angle '(0 0 0) (getvar "UCSXDIR"))) ) ) (setq textChoices '("test1" "test2" "test3" "test4" "test5" "test6" "User to input custom text")) (setq selectedIndex (getint (strcat "\nEnter the index of the desired text choice:\n" "1. test1\n" "2. test2\n" "3. test3\n" "4. test4\n" "5. test5\n" "6. test6\n" "7. User to input custom text\n" "Enter choice (1-7): "))) (setq selectedText (if (= selectedIndex 7) (getstring "\nEnter the custom text: ") (nth (1- selectedIndex) textChoices))) (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 8 "Test_text") (cons 7 "Arial") (cons 1 selectedText) (cons 40 0.15) (cons 10 (trans center dxf_210 0)) (cons 50 (angle '(0 0 0) (getvar "UCSXDIR"))) (cons 210 dxf_210) ) ) (princ) )

Hello friend, good morning, thank you very much for the help, it has worked wonderfully for me.

@leonucadomi As i ask for before, please UPLOAD your sample dwg with BEFORE and AFTER. Btw Did you try my lisp?

@MFEC Your problem is you are trying to go on to the next prompt before the MOVE command is completed. Command functions need to account for all input. Use PAUSE in a command to stop and get input before continuing. ;Change This (COMMAND "MOVE" CONJUNTO_SELECCION "" P1) ;into This (COMMAND "MOVE" CONJUNTO_SELECCION "" P1 pause);<--- Pause here allows you to complete the command before prompting to go on to the next loop.

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.

Your circle is not in the world UCS. If you set a UCS using the circle as the base, then all the snaps work perfectly.

Hi devitg maybe use Xline for the temporary line working out the second point on the ellipse. It auto extends to infinity.

Do you have Ortho on ? Press F8 for on off. Thne using mouse for angle should work.

Ok you can get the blocks into a selection set using a wild card search as 1st step, can then get attributes. Then you can check for an attribute tagname. (setq ss (ssget "X" '((0 . "INSERT")(cons 2 "Abschn_11_3_NN009*")))) <Selection set: 0000000064361620> : (sslength ss) 115 (vlax-get (nth 3 atts) 'Tagstring) "DN" (vlax-get (nth 3 atts) 'Textstring) "200.00" What do you know about lisp ?

What does -30 do. There is a command Lengthen.

Another method: (defun c:vpon ( / d s ) (vl-load-com) (if (setq s (ssget "_+.:S:E:L" '((0 . "VIEWPORT")))) (progn (setq d (vla-get-activedocument (vlax-get-acad-object))) (vla-put-mspace d :vlax-true) (vla-put-activeviewport d (vlax-ename->vla-object (ssname s 0))) ) ) (princ) ) And to 'deactivate': (defun c:vpoff ( ) (vla-put-mspace (vla-get-activedocument (vlax-get-acad-object)) :vlax-false) (princ) )

Or, using the fact that non tangential arc segments are not bevelled, draw your lines as a series of arc segments (of infinite radius), and join them up with pedit.