Lisp for Auto Fillet

August 17, 2023

Can anyone Help me to write a lisp me an AUTOCAD LISP;

Command is EE0

Pick Line 1

pick line 2

pick line 3

pick line 4

find the distance from line1 to line 2 SET VALUE D1

Find the distance from line 3 to line 4 SET VALUE D2

fillet line2 WITH line 3 FILLET RADIUS 0.25 * D2

fillet line1 WITH line 4 FILLET RADIUS 1.25 * D1

DRAW POLYLINE CONNECT WITH FILLET EDGE 1 WITH 2 DRAW POLYLINE CONNECT WITH FILLET EDGE 3 WITH 4

I found a few lisps online, But not fulfilling this particular requirement many thanks !!

August 17, 2023

@smallƑish Give this a try:

(defun c:foo (/ d p s)
  ;; RJP » 2023-08-17
  ;; Creates an elbow for two selected parallel polylines
  (cond	((and ;; (or (setq d (getdist "\nEnter pipe diameter:<10> ")) (setq d 10))
	      (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
	 )
	 (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	 (setq s (vl-sort s '(lambda (r j) (< (vlax-curve-getarea r) (vlax-curve-getarea j)))))
	 (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget (car s)))))
	 (setq d (distance (cadr p) (vlax-curve-getclosestpointto (cadr s) (cadr p))))
	 (setvar 'filletrad (* d 0.25))
	 (command "_.fillet" "_polyline" (car s))
	 (setvar 'filletrad (* d 1.25))
	 (command "_.fillet" "_polyline" (cadr s))
	 (setq p (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget (car s)))))
	 (setq p (list (cadr p) (caddr p)))
	 (foreach x p
	   (entmakex (list '(0 . "LWPOLYLINE")
			   '(100 . "AcDbEntity")
			   (assoc 8 (entget (car s)))
			   '(100 . "AcDbPolyline")
			   '(90 . 2)
			   (cons 10 x)
			   (cons 10 (vlax-curve-getclosestpointto (cadr s) x))
		     )
	   )
	 )
	)
  )
  (princ)
)

*Updated code to calculate diameter automatically:

Edited August 18, 2023 by ronjonp

August 18, 2023

@ ronjonp

Can you please how can i fix this issue?

August 18, 2023

46 minutes ago, smallƑish said:

@ ronjonp

Can you please how can i fix this issue?

Not sure? Need a sample drawing. Also .. the code works ( mostly ) with two offset polylines each with 3 vertices if you need something more complex look into the links I've pointed you to.

This works on most angles.

Edited August 18, 2023 by ronjonp

August 18, 2023

I got it was my mistake, it's working properly. Thank you so much.

I have 2 requests here;

1.A my Duct draw lisp is making lines, not polylines. ( Can the foo update for lines?)

if not

1.B Can we add an addition to select the lines and fillet it with 0 radius, and join it as a polyline? (video link below )

2. Can we do something to remember the duct size that we used last time, now the default value is "10"

https://www.dropbox.com/scl/fi/p6rocqlmb9rqtc1n1rpjn/DUCT-DRAFT.mp4?rlkey=aode45ah0o70hcmcfofv6d1ec&dl=0

Edited August 18, 2023 by smallƑish

August 18, 2023

video attached

August 18, 2023

@smallƑish

I use those two functions.

You may give its a try.

;;Draws a two-wire pipeline (polyline) filleted with a radius specified by the user
(DEFUN C:DDUCT  (/
            *error*
            GetPlineVer
            $$P $PC $SS
            ACDC
            CEL
            DFI DPW
            FRA
            LEN LSP
            MLA
            OCM ODI OLA
            PL1 PL2 PLW PWD
            SPW
            VL1 VL2
          )

  (DEFUN *error* (s)
    (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
    (if $SS (setq $SS (command "_.ERASE"  $SS "")))
    (if (and MLA OLA) (vla-put-lock OLA :vlax-true))
    (if OCM (setvar "CMDECHO" OCM))
    (if ACDC
      (progn
        (vla-endundomark ACDC)
        (vlax-release-object ACDC)
      )
    )
    (princ)
  )

  (DEFUN GetPlineVer (pOb)
    (mapcar
      (function cdr)
      (vl-remove-if-not
        (function (lambda (x) (= (car x) 10)))
        (entget pOb)
      )
    )
  )

  (setq ACDC  (vla-get-activedocument (vlax-get-acad-object))
        CEL   (getvar "CLAYER")
        OCM   (getvar "CMDECHO")
        FRA   (getvar "FILLETRAD")
        PLW   (getvar "PLINEWID")
        ODI   (getenv "DIST_DUCT")
        SPW   (if (= (getvar "CVPORT") 2) 0 1)
  )
  (vla-startundomark ACDC)
  (setvar "CMDECHO" 0)
  (if (equal
      (vla-get-lock
        (setq OLA
          (vla-item
            (vla-get-layers ACDC)
            CEL
          )
        )
      )
      :vlax-true
    )
    (setq MLA (not (vla-put-lock OLA :vlax-false)))
  )
  (if (and ODI (> (distof ODI) 0.))
    (progn
      (initget 14)
      (setq DPW (getdist (strcat "\nPipe diameter <" ODI ">: ")))
      (if (null DPW) (setq DPW (distof ODI)))
    )
    (progn
      (initget 15)
      (setq DPW (getdist "\nPipe diameter: "))
    )
  )
  (if (= FRA 0)
    (progn
      (initget 7)
      (setq DFI (getreal (strcat "\nElbow radius: ")))
    )
    (progn
      (initget 6)
      (setq DFI (getreal (strcat "\nElbow radius <" (rtos FRA) ">: ")))
      (if (null DFI) (setq DFI FRA))
    )
  )
  (initget 6)
  (setq WDT (getreal (strcat "\nPolyline width <" (rtos PLW) ">: ")))
  (if (null WDT) (setq WDT PLW))
  (setq $SS (ssadd))
  (while (setq $PC (if $PC (getpoint $PC "\nNext point: ") (getpoint "\nStart point: ")))
    (if (and $$P $PC)
      (ssadd
        (entmakex
          (mapcar
            (function cons)
            (quote (0 100 67 8 100 10 11))
            (list "LINE" "AcDbEntity" SPW CEL "AcDbLine" $$P $PC)
          )
        )
        $SS
      )
    )
    (setq   $$P $PC
            LSP (cons $PC LSP)
    )
  )
  (setvar "FILLETRAD" DFI)
  (setvar "PLINEWID" WDT)
  (if (not (tblobjname "LTYPE" "AXE"))
    (entmake
      (mapcar
        (function cons)
          (quote (0 100 100 2 70 3 72 73 40 49 74 49 74 49 74 49 74))
          (quote ("LTYPE" "AcDbSymbolTableRecord" "AcDbLinetypeTableRecord" "AXE" 0 "Axis dashdot line __ . __ . __ . __ . __ . __ . __ . __" 65 4 12.0 6.0 0 -3.0 0 0.0 0 -3.0 0))
      )
    )
  )
  (setq LEN
    (entmakex
      (append
        (mapcar
          (function cons)
          (quote (0 100 67 8 6 100 90 43))
          (list "LWPOLYLINE" "AcDbEntity" SPW CEL "AXE" "AcDbPolyline" (length LSP) 0)
        )
        (mapcar (function (lambda (x) (cons 10 x))) LSP)
      )
    )
  )
  (vl-cmdf  "_.FILLET" "_P" LEN
            "_.ERASE"  $SS ""
  )
  (setq   LEN (vlax-ename->vla-object LEN)
          PL1 (car (vlax-safearray->list (vlax-variant-value (vla-offset LEN (/ DPW  2.)))))
          PL2 (car (vlax-safearray->list (vlax-variant-value (vla-offset LEN (/ DPW -2.)))))
          VL1 (GetPlineVer (vlax-vla-object->ename PL1))
          VL2 (GetPlineVer (vlax-vla-object->ename PL2))
          $SS nil
  )
  (foreach el (list PL1 PL2)
    (vla-put-constantwidth el WDT)
    (vla-put-linetype el "ByLayer")
  )
  (while VL1
    (entmake
      (mapcar
        (function cons)
        (quote (0 100 67 8 100 6 10 11))
        (list "LINE" "AcDbEntity" SPW CEL "AcDbLine" "ByLayer" (car VL1) (car VL2))
      )
    )
    (setq   VL1 (cdr VL1)
            VL2 (cdr VL2)
    )
  )
  (if MLA (vla-put-lock OLA :vlax-true))
  (setenv "DIST_DUCT" (rtos DPW))
  (setvar "CMDECHO" OCM)
  (vla-endundomark ACDC)
  (vlax-release-object ACDC)
  (princ)
) ;C:DDUCT
;;(vlax-add-cmd "DDUCT" (quote DDUCT) "DDUCT" ACRX_CMD_MODAL)

;;Change a single-wire pipe into a two-wire (polyline), filleted with a radius specified by the user
(DEFUN C:EDUCT  (/
                  *error*
                  GetPlineVer
                  ACDC
                  CLI
                  DFI DPW
                  FRA
                  LLL LSE
                  NLA
                  PL1 PL2 PLS PLW
                  OCM ODI
                  SPW
                  VL1 VL2
                  WDT
                )

  (DEFUN *error* (s)
    (or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
    (if LLL ;;Refacere layere lock
      (mapcar
        (function
          (lambda (x) (vla-put-lock x :vlax-true))
        )
        LLL
      )
    )
    (if OCM (setvar "CMDECHO" OCM))
    (if ACDC
      (progn
        (vla-endundomark ACDC)
        (vlax-release-object ACDC)
      )
    )
    (princ)
  )

  (DEFUN GetPlineVer (pOb)
    (mapcar
      (function cdr)
      (vl-remove-if-not
        (function
          (lambda (x) (= (car x) 10))
        )
        (entget (vlax-vla-object->ename pOb))
      )
    )
  )
  (setq ACDC  (vla-get-activedocument (vlax-get-acad-object))
        OCM   (getvar "CMDECHO")
        FRA   (getvar "FILLETRAD")
        PLW   (getvar "PLINEWID")
        ODI   (getenv "DIST_DUCT")
        SPW   (if (= (getvar "CVPORT") 2) 0 1)
  )
  (vla-startundomark ACDC)
  (setvar "CMDECHO" 0)
  (if (and ODI (> (distof ODI) 0.))
    (progn
      (initget 14)
      (setq DPW (getdist (strcat "\nPipe diameter <" ODI ">: ")))
      (if (null DPW) (setq DPW (distof ODI)))
    )
    (progn
      (initget 15)
      (setq DPW (getdist "\nPipe diameter: "))
    )
  )
  (if (= FRA 0)
    (progn
      (initget 7)
      (setq DFI (getreal (strcat "\nElbow radius: ")))
    )
    (progn
      (initget 6)
      (setq DFI (getreal (strcat "\nElbow radius <" (rtos FRA) ">: ")))
      (if (null DFI) (setq DFI FRA))
    )
  )
  (initget 6)
  (setq WDT (getreal (strcat "\nPolyline width <" (rtos PLW) ">: ")))
  (if (null WDT) (setq WDT PLW))
  (setq   LSE   (ssget (list (quote  (0 . "LWPOLYLINE"))))
          PLS   (mapcar
                  (function vlax-ename->vla-object)
                  (vl-remove-if
                    (function listp)
                    (mapcar
                      (function cadr)
                      (ssnamex LSE)
                    )
                  )
                )
          LSE   nil
  )
  (setvar "FILLETRAD" DFI)
  (setvar "PLINEWID" WDT)
  (mapcar
    (function
      (lambda (x / LayObj)
        (if (equal (vla-get-lock (setq LayObj (vla-item (vla-get-layers ACDC) (vla-get-layer x)))) (quote :vlax-true))
          (progn
            (vla-put-lock LayObj :vlax-false)
            (setq LLL (cons LayObj LLL))
          )
        )
      )
    )
    PLS
  )
  (if (not (tblobjname "LTYPE" "AXE"))
    (entmake
      (mapcar
        (function cons)
          (quote (0 100 100 2 70 3 72 73 40 49 74 49 74 49 74 49 74))
          (quote ("LTYPE" "AcDbSymbolTableRecord" "AcDbLinetypeTableRecord" "AXE" 0 "Axis dashdot line __ . __ . __ . __ . __ . __ . __ . __" 65 4 12.0 6.0 0 -3.0 0 0.0 0 -3.0 0))
      )
    )
  )
  (foreach pl PLS
    (vl-cmdf "_.FILLET" "_P" (vlax-vla-object->ename pl))
    (setq   PL1 (car (vlax-safearray->list (vlax-variant-value (vla-offset pl (/ DPW  2.)))))
            PL2 (car (vlax-safearray->list (vlax-variant-value (vla-offset pl (/ DPW -2.)))))
            VL1 (GetPlineVer  PL1)
            VL2 (GetPlineVer  PL2)
            CLI (vla-get-color pl)
            NLA (vla-get-layer pl)
    )
    (vla-put-linetype pl  "AXE")
    (vla-put-constantwidth pl  0.)
    (while VL1
      (entmake
        (mapcar
          (function cons)
          (quote (0 100 67 8 100 6 62 10 11))
          (list "LINE" "AcDbEntity" SPW NLA "AcDbLine" "ByLayer" CLI (car VL1) (car VL2))
        )
      )
      (setq   VL1 (cdr VL1)
              VL2 (cdr VL2)
      )
    )
  )
  (foreach el (list PL1 PL2)
    (vla-put-constantwidth el WDT)
    (vla-put-linetype el "ByLayer")
  )
  (if LLL
    (mapcar
      (function
        (lambda (x) (vla-put-lock x :vlax-true))
      )
      LLL
    )
  )
  (setenv "DIST_DUCT" (rtos DPW))
  (setvar "CMDECHO" OCM)
  (vla-endundomark ACDC)
  (vlax-release-object ACDC)
  (princ)
) ;;C:EDUCT
;;(vlax-add-cmd "EDUCT" (quote EDUCT) "EDUCT" ACRX_CMD_MODAL)

August 18, 2023

@lido

This is what happended

August 18, 2023

@smallFish

The program is NOT error free! II use it succesfully to draw 2D ducts in ventilation installations.

August 18, 2023

@smallƑish I can help with these two .. the other I don't have time for. You should really look into a software package IMO.

Quote

1.A my Duct draw lisp is making lines, not polylines. ( Can the foo update for lines?)

if not

2. Can we do something to remember the duct size that we used last time, now the default value is "1

August 18, 2023

12 minutes ago, ronjonp said:

@smallƑish I can help with these two .. the other I don't have time for. You should really look into a software package IMO.

Thank you so much for your time. Awaiting eagerly to see the magic of your progrm.

August 18, 2023

1 hour ago, smallƑish said:

Thank you so much for your time. Awaiting eagerly to see the magic of your progrm.

Updated the code above .. now you don't have to enter the distance.

August 19, 2023

Like ronjonp find a program, google Tharwat duct program.

August 19, 2023

My HVAC Program.

https://autolispprograms.wordpress.com/hvac/hvac-application/

August 19, 2023

On 18/08/2023 at 19:53, ronjonp said:

Updated the code above .. now you don't have to enter the distance.

Thank You very much, It's working properly with polyline. Please let me know, if this will it work with both Lines.

Thank you!

September 4, 2023

On 18/08/2023 at 19:53, ronjonp said:

Updated the code above .. now you don't have to enter the distance.

Your code was modified to Skip Radius and line weight as it is constant. Can you advise me, on how to add the duct size on each segment, and delete the existing Polyline at the end of the process?

;;Change a single-wire pipe into a two-wire (polyline), filleted with a radius specified by the user
(DEFUN C:EDUCT (/
*error*
GetPlineVer
ACDC
CLI
DFI DPW
FRA
LLL LSE
NLA
PL1 PL2 PLS PLW
OCM ODI
SPW
VL1 VL2
WDT
)

(DEFUN *error* (s)
(or (wcmatch (strcase s) "*BREAK,*CANCEL*,*EXIT*") (prompt (strcat "\nError: " s)))
(if LLL ;;Refacere layere lock
(mapcar
(function
(lambda (x) (vla-put-lock x :vlax-true))
)
LLL
)
)
(if OCM (setvar "CMDECHO" OCM))
(if ACDC
(progn
(vla-endundomark ACDC)
(vlax-release-object ACDC)
)
)
(princ)
)

(DEFUN GetPlineVer (pOb)
(mapcar
(function cdr)
(vl-remove-if-not
(function
(lambda (x) (= (car x) 10))
)
(entget (vlax-vla-object->ename pOb))
)
)
)
(setq ACDC (vla-get-activedocument (vlax-get-acad-object))
OCM (getvar "CMDECHO")
FRA (getvar "FILLETRAD")
PLW (getvar "PLINEWID")
ODI (getenv "DIST_DUCT")
SPW (if (= (getvar "CVPORT") 2) 0 1)
)
(vla-startundomark ACDC)
(setvar "CMDECHO" 0)
(if (and ODI (> (distof ODI) 0.))
(progn
(initget 14)
(setq DPW (getdist (strcat "\nPipe diameter <" ODI ">: ")))
(if (null DPW) (setq DPW (distof ODI)))
)
(progn
(initget 15)
(setq DPW (getdist "\nPipe diameter: "))
)
)
(if (= FRA 0)
(progn
(initget 7)
(setq DFI (getreal (strcat "\nElbow radius: ")))
)
(progn
(initget 6)
(setq DFI (getreal (strcat "\nElbow radius <" (rtos FRA) ">: ")))
(if (null DFI) (setq DFI FRA))
)
)
(initget 6)
(setq WDT (getreal (strcat "\nPolyline width <" (rtos PLW) ">: ")))
(if (null WDT) (setq WDT PLW))
(setq LSE (ssget (list (quote (0 . "LWPOLYLINE"))))
PLS (mapcar
(function vlax-ename->vla-object)
(vl-remove-if
(function listp)
(mapcar
(function cadr)
(ssnamex LSE)
)
)
)
LSE nil
)
(setvar "FILLETRAD" DFI)
(setvar "PLINEWID" WDT)
(mapcar
(function
(lambda (x / LayObj)
(if (equal (vla-get-lock (setq LayObj (vla-item (vla-get-layers ACDC) (vla-get-layer x)))) (quote :vlax-true))
(progn
(vla-put-lock LayObj :vlax-false)
(setq LLL (cons LayObj LLL))
)
)
)
)
PLS
)
(if (not (tblobjname "LTYPE" "AXE"))
(entmake
(mapcar
(function cons)
(quote (0 100 100 2 70 3 72 73 40 49 74 49 74 49 74 49 74))
(quote ("LTYPE" "AcDbSymbolTableRecord" "AcDbLinetypeTableRecord" "AXE" 0 "Axis dashdot line __ . __ . __ . __ . __ . __ . __ . __" 65 4 12.0 6.0 0 -3.0 0 0.0 0 -3.0 0))
)
)
)
(foreach pl PLS
(vl-cmdf "_.FILLET" "_P" (vlax-vla-object->ename pl))
(setq PL1 (car (vlax-safearray->list (vlax-variant-value (vla-offset pl (/ DPW 2.)))))
PL2 (car (vlax-safearray->list (vlax-variant-value (vla-offset pl (/ DPW -2.)))))
VL1 (GetPlineVer PL1)
VL2 (GetPlineVer PL2)
CLI (vla-get-color pl)
NLA (vla-get-layer pl)
)
(vla-put-linetype pl "AXE")
(vla-put-constantwidth pl 0.)
(while VL1
(entmake
(mapcar
(function cons)
(quote (0 100 67 8 100 6 62 10 11))
(list "LINE" "AcDbEntity" SPW NLA "AcDbLine" "ByLayer" CLI (car VL1) (car VL2))
)
)
(setq VL1 (cdr VL1)
VL2 (cdr VL2)
)
)
)
(foreach el (list PL1 PL2)
(vla-put-constantwidth el WDT)
(vla-put-linetype el "ByLayer")
)
(if LLL
(mapcar
(function
(lambda (x) (vla-put-lock x :vlax-true))
)
LLL
)
)
(setenv "DIST_DUCT" (rtos DPW))
(setvar "CMDECHO" OCM)
(vla-endundomark ACDC)
(vlax-release-object ACDC)
(princ)
) ;;C:EDUCT
;;(vlax-add-cmd "EDUCT" (quote EDUCT) "EDUCT" ACRX_CMD_MODAL)

September 4, 2023

@smallFish

In order to delete selected plines:

1. It is not necessary to define the "AXE" line type.

2. Delete the lines:

    (vla-put-linetype pl  "AXE")
    (vla-put-constantwidth pl  0.)

and replace with:

(vla-delete pl)

In order to add the diameter...Sorry, but for the moment I don't have enough time for that.

September 4, 2023

8 minutes ago, lido said:
@smallFish

In order to delete selected plines:

1. It is not necessary to define the "AXE" line type.

2. Delete the lines:
    (vla-put-linetype pl  "AXE")
    (vla-put-constantwidth pl  0.)
and replace with:
(vla-delete pl)
In order to add the diameter...Sorry, but for the moment I don't have enough time for that.

Yeah, that's working perfectly. Thank you so much.

September 4, 2023

Can anyone please help me to merge the program with the above educt program to place the duct with text on the polyline vertices ?

Thank you so much.

label_dist-vertex_po.lsp

Edited September 11, 2023 by smallƑish

Lisp for Auto Fillet

Recommended Posts

smallƑish

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

lido

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

lido

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

ronjonp

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

lido

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

smallƑish

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity