Add radius to a Mline

[BIGAL]

In another post there was questions about changing Mline styles for existing Mlines.

 

So answered that and thought what about adding fillets to a mline. Wel as we know you can not do that, so did it this way. Converting the individual mlines to plines then filleting the plines produced. The fillet radius changing matching the offsets.

 

; Convert mline to plines and add a rdius.
; By AlanH Aug 2026

(defun LWPoly (lst cls)
          (entmakex (append (list (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 (length lst))
        (cons 70 cls))
    (mapcar (function (lambda (p) (cons 10 p))) lst)))
)

(defun c:ml2plrad ( / oldsnap pt1 pt2 ent obj obj2 co-ords dict col lst x)

  (setq oldsnap (getvar 'osmode))
  (setvar 'osmode 0)
  
  (setq pt1 (getpoint "\nPick 1st point for drag "))
  (setq pt2 (getpoint pt1 "\nPick 2nd point "))
  
  (setq pts (list pt1 pt2))
  (setq ent (ssname (ssget "F" pts (list (cons 0 "Mline"))) 0))
  (setq obj (vlax-ename->vla-object ent))
  (setq styleName (vla-get-StyleName obj))
  (setq lay (vlax-get obj 'layer))
  (setvar 'clayer lay)
  (setq co-ords (vlax-get obj 'coordinates))
  (vla-delete obj)
  (setq pts2 '() x 0)
  (repeat (/ (length co-ords) 3)
    (setq pts2 (cons (list (nth x co-ords)(nth (1+ x) co-ords)) pts2))
    (setq x (+ x 3))
  )
  (setq dict (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))) styleName))
  (setq offsets (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 49)) dict)))
  (setq col (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 62)) dict)))
  (setq col (cdr col))  ; ignore 1st color 
  (setq lst '() x 0)
    (repeat (length col)
    (setq lst (cons (list (nth x offsets)(nth x col)) lst))
    (setq x (1+ x))
  )
  
  (LWPoly pts2 0)
  
  (setvar 'filletrad (getreal "\nEnter Fillet radius for most outside offset "))
  (command "fillet"  "P" (entlast))
  
  (setq x 1)
  (repeat (- (length col) 1)
    (setq obj2 (vlax-ename->vla-object (entlast)))
    (vlax-put obj2 'color (nth (1- x) col))
    (vla-offset (vlax-ename->vla-object (entlast)) (- (nth  x offsets)(nth (1- x) offsets)))
    (setq x (1+ x))
  )
  
  (setq obj2 (vlax-ename->vla-object (entlast)))
  (vlax-put obj2 'color (nth (1- x) col))
  
  (setvar 'osmode oldsnap)
  (princ)
)
(c:ml2plrad)

 

Edited September 1 by BIGAL
Added image

[mhupp]

I Had a lisp that adds radius to polylines ignoring larger radius then what you where setting. Used it to adjust for CNC permitter routing to avoid share edges. 

[Tsuky]

Another way to do it: transform lines, polylines/polyarcs, circles or arcs into mutilines.
This way we retain the properties of the chosen multiline style. Arcs are simulated with segments.

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq
    tmp (vl-filename-mktemp "tmp.dcl")
    file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";")
      (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
    )
    file
  )
  (write-line "}spacer;ok_button;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
      (if (= 2 flag)
        (progn
          (foreach n (str2lst (get_tile \"lst\") \" \")
            (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
          )
          (setq choice (reverse choice))
        )
        (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
      )
    )
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)
(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
  (if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
  (while (cadr ls)
    (if (zerop (car lb))
      (setq l_new (append l_new (list (car ls))))
      (progn
        (setq
          rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
          a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
        )
        (if (< a 0.0) (setq a (- (* 2.0 pi) a)))
        (if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
          (setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
        )
      )
    )
    (setq ls (cdr ls) lb (cdr lb))
  )
  (append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
  (setq
    inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
    ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
    nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
  )
  (repeat nm
    (setq
      p1 (polar pt_cen inc rad)
      inc (+ inc (/ (* pi 2.0) 36.0))
      lst (append lst (list p1))
    )
  )
  (setq
    p2 (polar pt_cen ang rad)
    lst (append lst (list p2))
  )
  (if (< sens 0.0) (reverse lst) lst)
)
(defun c:polyarc2ml ( / jspl nbr l_mlstyl sel_styl ent dxf_ent typent name_layer closed lst l_bulg e_next dxf_next oldlayer oldosm key_mod scale_ml)
  (princ "\nSelect polylines/lines/circles/arcs for transform to multilines: ")
  (setq
    jspl (ssget '((0 . "*POLYLINE,LINE,CIRCLE,ARC") (-4 . "<NOT") (-4 . "&") (70 . 124) (-4 . "NOT>")))
    nbr 0
  )
  (cond
    (jspl
      (setq l_mlstyl
        (mapcar 'cdr
          (vl-remove-if-not
          '(lambda (x) (= (car x) 3))
            (dictsearch (namedobjdict) "ACAD_MLINESTYLE")
          )
        )
      )
      (while (not (setq sel_styl (listbox "Multilines style" "Choose a Multiline style" (mapcar 'cons l_mlstyl l_mlstyl) 1))))
      (setvar "cmlstyle" sel_styl)
      (initget "Top Zero Bottom")
      (setq key_mod
        (getkword
          (strcat
            "\nGive justification type [Top/Zero/Bottom] <"
            (cond
              ((eq (getvar "cmljust") 0)
                "Top"
              )
              ((eq (getvar "cmljust") 1)
                "Zero"
              )
              ((eq (getvar "cmljust") 2)
                "Bottom"
              )
            )
            ">: "
          )
        )
      )
      (if key_mod
        (cond
          ((eq key_mod "Top") (setvar "cmljust" 0))
          ((eq key_mod "Zero") (setvar "cmljust" 1))
          ((eq key_mod "Bottom") (setvar "cmljust" 2))
        )
      )
      (setq scale_ml (getdist (strcat "\nGive scale for multiline <" (rtos (getvar "cmlscale")) ">: ")))
      (if scale_ml (setvar "cmlscale" scale_ml))
      (setq oldlayer (getvar "clayer") oldosm (getvar "osmode"))
      (setvar "osmode" 0)
      (setvar "cmdecho" 0)
      (command "_.ucs" "_world")
      (repeat (sslength jspl)
        (setq
          typent (cdr (assoc 0 (setq dxf_ent (entget (setq ent (ssname jspl nbr))))))
          name_layer (cdr (assoc 8 dxf_ent))
        )
        (cond
          ((eq typent "LWPOLYLINE")
            (setq
              closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
              lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
              l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
              lst (def_bulg_pl lst l_bulg closed)
            )
          )
          ((eq typent "POLYLINE")
            (setq
              closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
              e_next (entnext ent)
            )
            (while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
              (if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
                (setq
                  lst (cons (trans (cdr (assoc 10 dxf_next)) ent 1) lst)
                  l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg)
                )
              )
              (setq e_next (entnext e_next))
            )
            (setq
              lst (reverse lst)
              l_bulg (reverse l_bulg)
              lst (def_bulg_pl lst l_bulg closed)
            )
          )
          ((eq typent "LINE")
            (setq
              lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1))
              closed 0
            )
          )
          ((eq typent "CIRCLE")
            (setq
              lst
                (bulge_pts
                  (trans (cdr (assoc 10 dxf_ent)) ent 1)
                  (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) 0.0 (cdr (assoc 40 dxf_ent)))
                  (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent)))
                  (cdr (assoc 40 dxf_ent))
                  1
                )
              lst (append lst (list (car lst)))
              closed 1
            )
          )
          ((eq typent "ARC")
            (setq
              lst
                (bulge_pts
                  (trans (cdr (assoc 10 dxf_ent)) ent 1)
                  (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                  (polar (trans (cdr (assoc 10 dxf_ent)) ent 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent)))
                  (cdr (assoc 40 dxf_ent))
                  1
                )
              closed 0
            )
          )
        )
        (cond
          (lst
            (setvar "clayer" name_layer)
            (command "_.mline")
            (foreach n lst (command n))
            (if (not (zerop closed)) (command "_close") (command ""))
            (entdel ent)
          )
        )
        (setq nbr (1+ nbr) lst nil l_bulg nil)
      )
      (command "_.ucs" "_previous")
      (setvar "clayer" oldlayer)
      (setvar "osmode" oldosm)
      (setvar "cmdecho" 1)
    )
    (T (princ "\nSelect is empty"))
  )
  (prin1)
)