Jump to content

recover fillet at end point

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited)

Tested FMP or decurve lisp (correct fillet radius to 0 value)

It works well in general situations (when the polyline has a straight line - an arc - a straight line).

However, it does not work in arc end polyline situations. (straight - arc) or (arc - straight) or (arc only)

 

This lisp uses both straight feature information instead of arc feature information.

So when the user selects arc,  Draw the line center from the arc start point to the arc center point and the arc end point to the arc center point.

 

Then rotate it 90 degrees to draw two circumscribed lines and extend them to get the intersection point.

Then draw a line from the arc start point to the corss point and draw a line end point from the intersection point and merge them.

 

I think this routine can solve this problem. But I can't express it in words. 

How can I get started? Or is there a better solution than this routine?

 

(image deleted)

 

Edited by exceed
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted

Helping you along here. Time for bed so i can't code.

https://documentation.help/AutoCAD-DXF/WS1a9193826455f5ff18cb41610ec0a2e719-7a35.htm

Arcs don't have start points and end points. They have start and end angles.

To calculate those outer points you have to use the center point (10), radius (40), and start and end angles (50) (51) with the polar command.

(setq arc (entget entity))

(setq cpt (cdr (assoc 10 arc) same for 40,50,51

(setq pt1 (polar cpt ang dist) ;this would get the white lines

You would then have to then have to add or subtract 90° from 50 & 51 and use polar again. ;this would get the red lines.

use lee mac's intersection with the acextendthisentity option.

 

Now that I write all that looking at the picture it looks like you could just extend the line the length of the arc but prob have to do some type of math to get the real length.

 

 

  • Like 1
Link to comment
Share on other sites
tombu Veteran

tombu

Posted
Posted (edited)

This lisp by ronjonp should do the trick: http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417

I renamed the command as AddArcTangents and saved it as AddArcTangents.lsp then modified it to work with preselected objects as well including arcs & lwpolylines.

Then added the macro 

^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents

Named "Add Arc Tangents" with description "Add Tangent Lines to arc sections." to my "LWPline Object Menu" so I can add them simply by right-clicking on a lwpolyline and picking "Add Arc Tangents". 

; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
(defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
  (defun _angle	(ename pt / ang clpt e param)
    (if	(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
	     (setq clpt (vlax-curve-getclosestpointto ename pt))
	     (setq param (vlax-curve-getparamatpoint ename clpt))
	     (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
	)
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
		    '(100 . "AcDbEntity")
		    (cons 8 layer)
		    (cons 10 p1)
		    (cons 11 p2)
	      )
    )
  )

  (princ "\nSelect Arc or Polyline ")
  (setq tmp (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
  (if tmp
    (progn
      (setq e (ssname tmp 0)
	    EnTyp (cdr (assoc 0 (entget e)))
      )
      (if (= EnTyp "LWPOLYLINE")
	(setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
	(setq tmp (list (vlax-ename->vla-object e)))
      )
;  (if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
      (foreach o tmp
        (if (= "AcDbArc" (vla-get-objectname o))
  	  (progn (setq sp (vlax-curve-getstartpoint o))
	         (setq ep (vlax-curve-getendpoint o))
	         (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
	         (_line sp p "Intersection")
	         (_line ep p "Intersection")
	         (if (= EnTyp "LWPOLYLINE")(vla-delete o))
	  )
	  (if (= EnTyp "LWPOLYLINE")(vla-delete o))
        )
      )
    )
  )

  (princ)
)

I've collected a lot of code and snippets from him over the years. Thanks again ronjonp.

Edited by tombu
  • Like 1
  • Thanks 1
Link to comment
Share on other sites
mhupp Grand Master

mhupp

Posted
Posted (edited)
2 hours ago, tombu said:

 then modified it to work with preselected objects as well including arcs & lwpolylines.

 

Well you didn't save it then 😜 need to update to this. 

; ronjonp http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
(defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
  (defun _angle (ename pt / ang clpt e param)
    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
             (setq clpt (vlax-curve-getclosestpointto ename pt))
             (setq param (vlax-curve-getparamatpoint ename clpt))
             (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
        )
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 layer)
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )
  (if (ssget "_I")
    (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
    (progn
      (princ "\nSelect Arc or Polyline ")
      (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
    )
  )
  (if SS
    (foreach tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq e tmp
            EnTyp (cdr (assoc 0 (entget e)))
      )
      (if (= EnTyp "LWPOLYLINE")
        (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
        (setq tmp (list (vlax-ename->vla-object e)))
      )
      ;(if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
      (foreach o tmp
        (if (= "AcDbArc" (vla-get-objectname o))
          (progn
            (setq sp (vlax-curve-getstartpoint o))
            (setq ep (vlax-curve-getendpoint o))
            (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
            (_line sp p "Intersection")
            (_line ep p "Intersection")
            (if (= EnTyp "LWPOLYLINE") (vla-delete o))
          )
          (if (= EnTyp "LWPOLYLINE") (vla-delete o))
        )
      )
    )
    (Prompt "\nNo Arcs or Polylines Selected")
  )
  (princ)
)

 

And yes @ronjonp is one of the 🐐's

Edited by mhupp
  • Like 1
Link to comment
Share on other sites
exceed Proficient

exceed

Posted
  • Author
Posted
Quote
14 hours ago, mhupp said:

 

Well you didn't save it then 😜 need to update to this. 




; ronjonp http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
(defun c:AddArcTangents (/ _angle _line e ep p sp tmp)
  (defun _angle (ename pt / ang clpt e param)
    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
             (setq clpt (vlax-curve-getclosestpointto ename pt))
             (setq param (vlax-curve-getparamatpoint ename clpt))
             (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
        )
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 layer)
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )
  (if (ssget "_I")
    (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
    (progn
      (princ "\nSelect Arc or Polyline ")
      (setq SS (ssget "+.:E:S" '((0 . "arc,lwpolyline"))))
    )
  )
  (if SS
    (foreach tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq e tmp
            EnTyp (cdr (assoc 0 (entget e)))
      )
      (if (= EnTyp "LWPOLYLINE")
        (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
        (setq tmp (list (vlax-ename->vla-object e)))
      )
      ;(if (and (setq e (car (entsel))) (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode)))
      (foreach o tmp
        (if (= "AcDbArc" (vla-get-objectname o))
          (progn
            (setq sp (vlax-curve-getstartpoint o))
            (setq ep (vlax-curve-getendpoint o))
            (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
            (_line sp p "Intersection")
            (_line ep p "Intersection")
            (if (= EnTyp "LWPOLYLINE") (vla-delete o))
          )
          (if (= EnTyp "LWPOLYLINE") (vla-delete o))
        )
      )
    )
    (Prompt "\nNo Arcs or Polylines Selected")
  )
  (princ)
)

 

And yes @ronjonp is one of the 🐐's

 

Thanks  @ronjonpand @mhupp@tombu!!

 

I edit little bit of that code for my works.

1. delete ssget :S option for multi selection, add :L for except locked layer.

2. use object layer

3. leave exploded line. instead of original one.

  

; ronjonp http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417
; by ronjonp
; modified it to work with preselected objects as well including arcs & lwpolylines - by Tom Beauford
; (load "AddArcTangents.lsp") AddArcTangents
; ^P(or C:AddArcTangents (load "AddArcTangents.lsp"));AddArcTangents
; http://www.theswamp.org/index.php?topic=49865.msg550417#msg550417

(defun c:pj (/ ss1)
   (setq varlist (list "cmdecho" "peditaccept")
     oldvars (mapcar 'getvar varlist)
   ) ;_  end setq
   (mapcar 'setvar varlist (list 0 1))
   (setq ss1 (ssget))
   (if    (> (sslength ss1) 1)
   (progn
       (vl-cmdf "_pedit" "_M" ss1 "" "J" "0" "")
       (princ (strcat "\n" (itoa (sslength ss1)) " Lines Converted. "))
   ) ;_  end progn
   (progn
       (vl-cmdf "_pedit" ss1 "")
       (princ (strcat "\n" (itoa (sslength ss1)) " Line Converted. "))
   ) ;_  end progn
   ) ;_  end if
   (mapcar 'setvar varlist oldvars)
   (princ)
) ;_  end defun

(defun c:AddArcTangents (/ _angle _line e ep p sp tmp objlay)
  (defun _angle (ename pt / ang clpt e param)
    (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename))))
             (setq clpt (vlax-curve-getclosestpointto ename pt))
             (setq param (vlax-curve-getparamatpoint ename clpt))
             (setq ang (angle '(0 0) (vlax-curve-getfirstderiv ename param)))
        )
      ang
    )
  )
  (defun _line (p1 p2 layer)
    (entmakex (list '(0 . "LINE")
                    '(100 . "AcDbEntity")
                    (cons 8 layer)
                    (cons 10 p1)
                    (cons 11 p2)
              )
    )
  )
  (if (ssget "_I")
    (setq SS (ssget "_:L" '((0 . "arc,lwpolyline"))))
    (progn
      (princ "\nSelect Arc or Polyline ")
      (setq SS (ssget "_:L" '((0 . "arc,lwpolyline"))))
    )
  )
  (if SS
    (foreach tmp (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq e tmp
            EnTyp (cdr (assoc 0 (entget e)))
      )
      (if (= EnTyp "LWPOLYLINE")
        (setq tmp (vlax-invoke (vlax-ename->vla-object e) 'explode))
        (setq tmp (list (vlax-ename->vla-object e)))
      )
      (foreach o tmp
        (if (= "AcDbArc" (vla-get-objectname o))
          (progn
            (setq sp (vlax-curve-getstartpoint o))
            (setq ep (vlax-curve-getendpoint o))
			(setq objlay (vla-get-layer o))
            (setq p (inters sp (polar sp (_angle o sp) 1) ep (polar ep (_angle o ep) 1) nil))
            (_line sp p objlay)
			(_line ep p objlay)
            ;(if (= EnTyp "LWPOLYLINE") (vla-delete o)
			(vla-delete o)
            ;)
          )
          ;(if (= EnTyp "LWPOLYLINE") (vla-delete o)
          ;(vla-delete o)
          ;)
        )
      )
    )
    (Prompt "\nNo Arcs or Polylines Selected")
  )
  (command "erase" SS "")
  (princ)
)

 

 

so I get some of line what I want!!

and then, just convert to polyline and join it as much as possible.

thanks for your help😆😆😆😆

 

2021-12-07 14;34;15.PNG

  • Like 2
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...