Leaderboard

You may have found this if you google, it does exactly what you want type Fxxx and it sets fillet to that radius, there is also Cxxx for circles and offset more could be added. There is one little quirk with the program because it uses error trapping you enter 1.5 as 1-5 the "-" is used as a decimal point, if you enter F1.5 it will error as the error check finds the "." and treats the error check method differently. ; Enter the filet radius as part of a command line entry f100, offset O234, circle c123-45, P123 for pline width ; note - is used for decimal point ; original code and methology by Alan H ; assistance and code that worked by Lee-Mac ; OCT 2015 ( (lambda nil (vl-load-com) (foreach obj (cdar (vlr-reactors :vlr-command-reactor)) (if (= "fillet-reactor" (vlr-data obj)) (vlr-remove obj) ) ) (vlr-command-reactor "fillet-reactor" '((:vlr-unknowncommand . fillet-reactor-callback))) ) ) (defun plwid ( / width oldwidth) (setq width (distof (substr com 2) 2)) (setq oldwidth (getvar 'plinewid)) (if (<= 0.0 width) (progn (setvar 'plinewid width ) (vla-sendcommand fillet-reactor-acdoc "_.pline ") (setvar 'plinewid oldwidth) ) ) ) (defun filletrad ( / rad) (setq rad (distof (substr com 2) 2)) (if (<= 0.0 rad) (progn (setvar 'filletrad rad) (vla-sendcommand fillet-reactor-acdoc "_.fillet ") ) ) ) (defun makecirc ( / rad) (setq rad (distof (substr com 2) 2)) (if (<= 0.0 rad) (progn (setvar 'circlerad rad) (vla-sendcommand fillet-reactor-acdoc "_.Circle ") ) ) ) (defun offdist ( / dist) (setq dist (distof (substr com 2) 2)) (if (<= 0.0 dist) (progn (setvar 'offsetdist dist) (vla-sendcommand fillet-reactor-acdoc "_.Offset ") ) ) ) (defun fillet-reactor-callback ( obj com ) (setq com (vl-string-translate "-" "." (strcase (car com)))) (cond ( (and (wcmatch com "~*[~F.0-9]*") (wcmatch com "F*") (wcmatch com "~F*F*") (wcmatch com "~*.*.*") ) ; and (filletrad) ) ( (and (wcmatch com "~*[~C.0-9]*") (wcmatch com "C*") (wcmatch com "~C*C*") (wcmatch com "~*.*.*") ) ;and (makecirc) ) ( (and (wcmatch com "~*[~O.0-9]*") (wcmatch com "O*") (wcmatch com "~O*O*") (wcmatch com "~*.*.*") ) ; and (offdist) ) ( (and (wcmatch com "~*[~P.0-9]*") (wcmatch com "P*") (wcmatch com "~P*P*") (wcmatch com "~*.*.*") ) ; and (plwid) ) ) ; master cond ) ; defun (princ) (or fillet-reactor-acdoc (setq fillet-reactor-acdoc (vla-get-activedocument (vlax-get-acad-object))) ) (princ) ; next Point or option keyword required.

Just beaten to it in the time it took me to log in.... A slightly difffernt method here - there are many ay to do many things. I was going to suggest making 2 routines, keeping one for breaking a single polyline and another to do a loop hrough the selection set (sometimes this is good that you can use the main code for many things) The loop: (defun c:test ( / ss acount ) (setq acount 0) ;; a counter (setq ss (ssget '((0 . "*POLYLINE")))) ;;select poylines (while (< acount (sslength ss)) (test (ssname ss acount)) ;;call functon 'test' (setq acount (+ acount 1)) ) ;; end while ) and then modifyng your c:test above, ;;; Break pline @ vertices LPS 2010-04-01 ;;;(defun c:test (/ idx obj endparam ptlst) (defun test ( myent / idx obj endparam ptlst) (vl-load-com) (setq temperr *error*) (setq *error* errortrap) ;;;;(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) ) (setq obj (vlax-ename->vla-object (setq ent myent)) ) (if (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline") (princ "\nSelected entity is not a polyline") ) ;;end if (setq ptlst (list (vlax-curve-getStartPoint obj)) idx 1 ) (if (zerop (vlax-get obj 'Closed)) (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices ) ;;end if (while (<= idx endparam) (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst) idx (1+ idx) ) ) ;;end while ;;;; (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst) (mapcar (function (lambda (x) (vl-cmdf "break" (vlax-curve-getStartPoint obj) "f" x "@"))) ptlst) ) ;; end defun (defun errortrap (msg) (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n<< Error: " msg " >>")) ) ;;end if (setq *error* temperr) (princ) ) or something like this - evening here so CAD is off, didn't test this

Give this a try: (defun c:foo (/ a b el h pts s) ;; RJP » 2022-08-31 ;; Explode LWPOLYLINES and keep segment widths (if (setq s (ssget ":L" '((0 . "LWPOLYLINE")))) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (setq h (assoc 10 (setq el (entget e '("*"))))) (setq h (vl-remove (assoc 70 el) (reverse (cdr (member h (reverse el)))))) (setq pts (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42 91))) el)) (if (vlax-curve-isclosed e) (setq pts (append pts (mapcar '(lambda (r j) r) pts '(0 0 0 0 0)))) ) (while (> (length pts) 5) (entmakex (append h (mapcar '(lambda (r j) r) pts '(0 0 0 0 0 0 0 0 0 0)) (list (assoc 210 el))) ) (setq pts (cdddr pts)) (setq pts (cddr pts)) ) (entdel e) ) ) (princ) )

@mhupp just realised that the getdist ( @ronjonp trick) covers both user input and selecting distance by points on the drawing, so only 2 function are needed for me ( the FF and the RR).

@mhupp You are most welcome!! 1. about the getdist - Although I am not a person of imperial measurements but of metric measurements, this is an important option because it allows the user to get the radius from objects in the drawing itself, so at least for me it is one more function and not a replacement for getreal function - thanks for that, I have added it to my lisp, and thanks to @ronjonp as well for that trick. 2. about the second one, the option to get the radius from any object that has a center point - NICE!!!... added as well! thanks (Again... ) aridzv. *Comment: for me the first functions (F1,F2, etc') are quite unnecessary, Mainly after you added the last two functions - by distance on the drawing and by radius of an object, so I went with these three functions (radius as number, radius from dist between objects and radius from a curve) and gave up the first ones.

Thank you for the kind words. getdist is a little better because you can use things like 6' or 5 1/4 (defun C:FF (/ FRad) (or (setq FRad (getdist "\nFillet Radius<0>: ")) (setq FRad 0)) ;ronjonp trick (frx (rtos FRad 2 3)) ) Have another one. This is used if you want to mach an existing fillet but don't know the radius. allows you to select anything that has a center point and matches it's radius. Then goes into the fillet command. You could feed this into frx but i like to keep the radius change. ;;----------------------------------------------------------------------------;; ;; Apply the radius of a selected curved object in the Fillet command (defun C:RR (/ ent pt r) (if (setq ent (entsel "Select Curve: ")) (progn (setq pt (cadr ent)) (if (setq r (distance (osnap pt "nea") (osnap pt "cen"))) (progn ;could use frx here if you don't want to keep the radius (setvar 'filletrad r) (vl-cmdf "_.fillet" "M") ) (prompt "\nNo Radius Found.") ) ) ) (princ) )

@mhupp As usual - your lisp are effective,clear and as simple as it can be! I've added one more option - to let the user to choose the fillet radius (option FF): (defun C:F1 () (frx "0.0625")) (defun C:F2 () (frx "0.125")) (defun C:F3 () (frx "0.250")) (defun C:F4 () (frx "0.375")) (defun C:F5 () (frx "0.500")) (defun C:FF (/ FRad) (setq FRad (getreal "\nFillet Radius<0>: ")) (if (= FRad nil) (setq FRad 0) ) (frx (rtos FRad 2 3)) ) ;;----------------------------------------------------------------------;; ;; Quick Fillet with set radius (defun frx (x / *error* ofr) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ) ; if (setvar 'filletrad ofr) ) (setvar "cmdecho" 0) (setq ofr (getvar 'filletrad)) (vl-cmdf "_.Fillet" "_Radius" x "_.Fillet" "_Multiple") (setvar "cmdecho" 1) (princ (strcat "\nFillet (radius=" x "): Select first entity or [Fillet Settings.../Polyline/Radius/Trim/Undo/Multiple]:")) (while (> (getvar 'cmdactive) 0) (command pause)) (setvar 'filletrad ofr) (princ) ) and again - well done!! Regards, aridzv.

This is what I use for common fillets. --edit Its set to run multiple but only draw back is if you miss click on like the 20th fillet and hit Esc it will undo all fillets. so if you mess up just exit out of the command and fix the one mistake. Also only temp overrides the fillet radius for the commands. --edit oops sorry Tombu (defun C:F1 () (frx "0.0625")) (defun C:F2 () (frx "0.125")) (defun C:F3 () (frx "0.250")) (defun C:F4 () (frx "0.375")) (defun C:F5 () (frx "0.500")) ;;----------------------------------------------------------------------;; ;; Quick Fillet with set radius (defun frx (x / *error* ofr) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ) ; if (setvar 'filletrad ofr) ) (setvar "cmdecho" 0) (setq ofr (getvar 'filletrad)) (vl-cmdf "_.Fillet" "_Radius" x "_.Fillet" "_Multiple") (setvar "cmdecho" 1) (princ (strcat "\nFillet (radius=" x "): Select first entity or [Fillet Settings.../Polyline/Radius/Trim/Undo/Multiple]:")) (while (> (getvar 'cmdactive) 0) (command pause)) (setvar 'filletrad ofr) (princ) )

I am glad it helped you. Here is a diagram of how the data for the pattern definition file is derived.

Not a problem , here is a complete one to work on the two sides besides that one more option for both . Try it and let me know ... (defun c:Test (/ leg _LW ss lt rt k) ;; Tharwat 06. jan. 2014 ;; (defun leg (x e) (cdr (assoc x (entget e)))) (defun _LW (pts) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts)) '(70 . 0) ) (mapcar (function (lambda (p) (cons 10 (list (car p) (cadr p))))) pts) ) ) ) (princ "\n Select Dimensions ...") (if (setq ss (ssget '((0 . "*DIMENSION")))) (progn ((lambda (i / sn a b) (while (setq sn (ssname ss (setq i (1+ i)))) (if (< (car (setq a (leg 13 sn))) (car (setq b (leg 14 sn)))) (setq rt (cons b rt) lt (cons a lt) ) (setq rt (cons a rt) lt (cons b lt) ) ) ) ) -1 ) (if (and (> (length lt) 1) (> (length rt) 1)) (if (progn (initget 6 "Left Right Both") (setq k (cond ((getkword (strcat "\n Specify a side [Left/Right/Both] < " (cond (*side*) ((setq *side* "Left")) ) " > :" ) ) ) (*side*) ) ) ) (cond ((eq k "Left") (mapcar '_LW (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q))))))) ((eq k "Right") (mapcar '_LW (list (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q))))))) (t (mapcar '_LW (list (vl-sort lt '(lambda (p q) (< (cadr p) (cadr q)))) (vl-sort rt '(lambda (p q) (< (cadr p) (cadr q)))) ) ) ) ) ) (princ "\n <!> You should select two dimensions at least <!> ") ) ) ) (princ) )