Leaderboard

I merged your threads. No need to create new threads for the same question.

It's better? (defun c:test (/ ESP sel nums A1 A2 esp2 volu pes A3 pes2 ) (setvar "cmdecho" 0) (setq ESP (getreal "\nIngresa espesor en mm. ")) (prompt "\nSelecciona polilineas a extruir: ") (setq sel (ssget '((0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>")))) (setq nums (sslength sel)) (setq n 0) (repeat nums (setq nt (ssname sel n)) (command "_.area" "_object" nt) (setq A1 (getvar "area")) (setq A2 (/ A1 1000000)) (setq esp2 (/ ESP 1000)) (setq volu (* A2 esp2)) (setq pes (* volu 7850)) (command "_.extrude" nt "" ESP) (setq A3 ( LM:rtos (/ A1 1000000) 2 3)) (setq pes2 ( LM:rtos pes 2 3)) (princ (strcat "\nArea(M2)" " de objeto " (itoa (1+ n)) " = " A3)) (princ (strcat "\nPeso(Kg)" " de objeto " (itoa (1+ n)) " = " pes2)) (setvar "cmdecho" 0) (setq n (1+ n)) );repeat nums (textscr) (princ "\nTotal de elementos extruidos = ") (princ nums) (princ) );fin defun ;; rtos wrapper - Lee Mac ;; A wrapper for the rtos function to negate the effect of DIMZIN (defun LM:rtos ( real units prec / dimzin result ) (setq dimzin (getvar 'dimzin)) (setvar 'dimzin 0) (setq result (vl-catch-all-apply 'rtos (list real units prec))) (setvar 'dimzin dimzin) (if (not (vl-catch-all-error-p result)) result ) )

@pkenewell i will have to take more time out from drawing poxy retaining walls and have a play at simple LISP files for my self. Many thanks Paul

Thank you for answer

I think MHUPPS idea is more a proof that his idea works - if the basics work add a little more info and I am sure he will be along as and when he gets chance to update and improve the code. I was just about to reply that I had uploaded a second code, a modification of MHUPPs above adding my first snippet of code in there. My first post was just an idea for him but I didn't make that too clear, whoops. The second code builds on what MHUPP did and deletes the original lines. I've followed what he writes for a while now and no doubt if he has a proof of concept here, then he has an idea to improve it for the next stage (he is however busy, depends on the time he has available of course). Multiple selections might be trickier to separate out each arc individually, I'll have a think.

Just merging our 2 ideas together, kind of works (defun c:foo (/ p1 p2 p3 MyList) ;;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) ) ) ;;end sub functions (setq MyList (uniquepoints (setq MySS (ssget '((0 . "LINE"))))));; 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 ; (setq p1 (getpoint "Select End point Point"));;SP Commented out ; (setq p2 (getpoint "Select Mid Point"));;SP Commented out ; (setq p3 (getpoint "Select End point Point"));;SP Commented out (setq line1 (car (entsel "Select line"))) (setq line2 (car (entsel "Select line"))) (setvar 'filletrad (3PR p1 p2 p3)) (command "fillet" line1 line2) (command "erase" MySS "") ; delete original lines: SP ADDED )

I guess you want to make this process quicker: Arc command Select start point Select mid point Select end point Delete existing lines?

Here are some more examples, along with a quick performance comparison.