Jump to content

A MODIFIED CHAMFER FOR CUSTOM USE

tefached2809

By tefached2809
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

tefached2809 Apprentice

tefached2809

Posted
  • Author
Posted (edited)

thank you all for your help! i got all your lisp and will use it depending on what the drawing is presented to me, polyline or line.

 

it's really close to what i wanted and can work as intended.

and i am already happy with what you guys gave me.

 

PS: but for expert LISP writers out there here's the more detailed explanation on how i wanted the command

SUMMARY: A custom command just like chamfer or fillet that does a "notch" instead of an arc (for fillet) or a diagonal (for chamfer)


Details:

  1. can work on lines or polylines
  2. case 1 if objects is short to the intersection it extends it up to the notch
  3. case 2 if objects is longer than the intersection it trims it up to the notch
  4. case 3 if lines meet at intersection it creates the notch
  5. case 4 if objects are lines everything are created as lines (just like chamfer would do)
  6. case 5 if one object is polyline it joins objects into the polyline (just like chamfer would do)
  7. case 6 in case 0 distance is used it will extend or trim the line to meet at intersection (just like fillet and chamfer)

Procedure:

  1. type in command
  2. type in distance / use previous distance (distance is recorded in case of multiple uses (just like chamfer do)
  3. pick object 1
  4. pick object 2

end.


 

1.png

Edited by tefached2809
  • Like 1
  • Replies 31
  • Created
  • Last Reply

Top Posters In This Topic

  • tefached2809

    12

  • Steven P

    10

  • devitg

    5

  • Emmanuel Delay

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

devitg
devitg

Please test it for lines       notch-lines.LSP

Steven P
Steven P

Still a bit of a work in progress, but try this - it should work for polylines and lines but not a mix of the 2 yet. Got to add in remembering the last chamfer value (it defaults to 5 just now)  

marko_ribar
marko_ribar

Here is my attempt :   (defun c:cha-lws-2-lins ( / *error* tttt wcs initvalueslst ucsf ti ss i lw lwx data lil s el ) (defun *error* ( m ) (if wcs (if ucsf (while

Posted Images

Steven P Grand Master

Steven P

Posted
Posted

Still a bit of a work in progress, but try this - it should work for polylines and lines but not a mix of the 2 yet. Got to add in remembering the last chamfer value (it defaults to 5 just now)

 

  

(defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa)
  ;;https://forums.autodesk.com/t5/autocad-forum/break-at-point/td-p/7553581
  (defun BAP ( entity point /)
    (setq entity (list entity point)) ; recreate entsel.... Added this line
    (command "_.break" entity "_F" "_non" point "_non" point)
  )
  (defun MakeLine ( con10 con11 /  )
    (entmakex (append (list (cons 0 "LINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbLine")
                            (cons 10 con10)
                            (cons 11 con11)
              ))
    )
  )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-polyline-segment/td-p/1758253
  (defun test ( msg / elst ename pt param preparam postparam) ; returns selected line coordinates
    (setq elst (entsel msg))
    (if (= (cdr (assoc 0 (entget (car elst)))) "LINE")
      (progn
        (list (cdr (assoc 10 (entget (car elst))))(cdr (assoc 11 (entget (car elst)))) elst)
      ) ; end progn
      (progn
        (setq ename (car elst))
        (setq pt (cadr elst))
        (setq pt (vlax-curve-getClosestPointTo ename pt))
        (setq param (vlax-curve-getParamAtPoint ename pt))
        (setq preparam (fix param))
        (setq postparam (1+ preparam))
        (list
          (vlax-curve-getPointAtParam ename preparam)
          (vlax-curve-getPointAtParam ename postparam)
          elst
        )
      ) ; end progn
    ) ; end if
  )
  (defun trimlinetopt ( MyLine TrimPt1 TrimPt2 /  MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPT MyLineA MyLineB)
    (command "zoom" "Object" MyLine "")
    (command "zoom" "0.95x")
    (setq MyLineDef (entget MyLine))
    (setq MyLineEndA (cdr (assoc 10 MyLineDef)))
    (if (= (cdr (assoc 0 MyLineDef)) "LINE")
      (setq MyLineEndB (cdr (assoc 11 MyLineDef)))
      (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef))))
    )
  ;;sort trimpts according to distance from end A
    (setq Pt1Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt1 "nea")) )
    (setq Pt2Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt2 "nea")) )
    (if ( > Pt1Dist Pt2Dist)
      (progn
        (setq TempPt TrimPt1)
        (setq TrimPt1 TrimPt2)
        (setq TrimPt2 TempPt)
      ) ;end progn
    ) ;end if
    (BAP MyLine TrimPt1)
    (setq MyLineA (entlast))
    (BAP MyLineA TrimPt2)
    (setq MyLineB (entlast))
    (entdel MyLineA)
    (command "zoom" "Previous")
    (command "zoom" "Previous")
    MyLineA
  )

;; add here something nice like "select lines or [option]"
;; Also add here something nice to remember value from last time
  (setq chdist 5)
  (setq chdist (getreal (strcat "Enter Chamfer Distance: " (rtos chdist))))
  (if (or (= chdist 0)(= chdist nil))(setq chdist 5))
  (setq coords1 (test "\nSelect Line or segment 1: "))
  (setq pline1 (car (last coords1)))

  (cond
    ( (= (cdr (assoc 0 (entget pline1))) "LINE")
      (setq MyType "Line")
      (setq chdisttemp 0)
      (command "chamfer" (cadr (last coords1)) "Distance" chdisttemp chdisttemp (setq pt (getpoint)) )
      (setq pline2 (nentselp pt))
      (setq NL1 (makeline (car coords1)(cadr coords1)) )
      (setq NL2 (makeline (cdr (assoc 10 (entget (car pline2)))) (cdr (assoc 11 (entget (car pline2)))) ))
    )
    ((= (cdr (assoc 0 (entget pline1))) "LWPOLYLINE")
      (setq MyType "Polyline")
      (setq coords2 (test "\nSelect Line or segment 2: "))
      (setq pline2 (car (last coords2)))
      (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
      (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
    )
    (t
      (princ "Can't do a mix of lines... just now")
      (setq MyType "Mix")
    )
  ) ; end conds

  (command "chamfer" NL1 "Distance" chdist chdist NL2)
  (setq NL3 (entlast))
  (setq NL3PtA (cdr (assoc 10 (entget NL3))) )
  (setq NL3PtB (cdr (assoc 11 (entget NL3))) )
  (command "move" NL1 "" NL3PtA NL3PtB )
  (command "move" NL2 "" NL3PtB NL3PtA )

  (cond
    ((= MyType "Line")
      (command "extend" NL1 NL2 "" NL1 NL2 "")
      (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) )
      (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int)))
      (entdel NL1)
      (entdel NL2)
      (setq NL1 (makeline ptsa NL3PtA) ); templine 3
      (setq NL2 (makeline ptsa NL3PtB) ); templine 4
      (entdel NL3)
      (command "chamfer" NL1 "Distance" chdisttemp chdisttemp pline1)
      (command "chamfer" NL2 "Distance" chdisttemp chdisttemp pline2)
    )
    ((= MyType "Polyline")
      (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) )
      (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int)))
      (entdel NL1)
      (entdel NL2)
      (setq NL1 (makeline ptsa NL3PtA) ); templine 3
      (setq NL2 (makeline ptsa NL3PtB) ); templine 4
      (entdel NL3)
      (trimlinetopt pline1 NL3PtA NL3PtB)
      (command "join" pline1 (entlast) NL1 NL2 "")
    )
  ) ; end conds

  (princ)
)

 

 

 

  • Like 2
  • Thanks 1
mhupp Grand Master

mhupp

Posted
Posted

Just my 0.02¢ for Case 3 though 5. Use a fillet of 0 to close the gaps. Then process the lines after to apply the square chamfer.

 

 

image.png.8bd00a33bcf3fa608ec42cf1bcdf1af2.png

  • Like 1
tefached2809 Apprentice

tefached2809

Posted
  • Author
Posted
4 hours ago, Steven P said:

Still a bit of a work in progress, but try this - it should work for polylines and lines but not a mix of the 2 yet. Got to add in remembering the last chamfer value (it defaults to 5 just now)

 

  

(defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa)
  ;;https://forums.autodesk.com/t5/autocad-forum/break-at-point/td-p/7553581
  (defun BAP ( entity point /)
    (setq entity (list entity point)) ; recreate entsel.... Added this line
    (command "_.break" entity "_F" "_non" point "_non" point)
  )
  (defun MakeLine ( con10 con11 /  )
    (entmakex (append (list (cons 0 "LINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbLine")
                            (cons 10 con10)
                            (cons 11 con11)
              ))
    )
  )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-polyline-segment/td-p/1758253
  (defun test ( msg / elst ename pt param preparam postparam) ; returns selected line coordinates
    (setq elst (entsel msg))
    (if (= (cdr (assoc 0 (entget (car elst)))) "LINE")
      (progn
        (list (cdr (assoc 10 (entget (car elst))))(cdr (assoc 11 (entget (car elst)))) elst)
      ) ; end progn
      (progn
        (setq ename (car elst))
        (setq pt (cadr elst))
        (setq pt (vlax-curve-getClosestPointTo ename pt))
        (setq param (vlax-curve-getParamAtPoint ename pt))
        (setq preparam (fix param))
        (setq postparam (1+ preparam))
        (list
          (vlax-curve-getPointAtParam ename preparam)
          (vlax-curve-getPointAtParam ename postparam)
          elst
        )
      ) ; end progn
    ) ; end if
  )
  (defun trimlinetopt ( MyLine TrimPt1 TrimPt2 /  MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPT MyLineA MyLineB)
    (command "zoom" "Object" MyLine "")
    (command "zoom" "0.95x")
    (setq MyLineDef (entget MyLine))
    (setq MyLineEndA (cdr (assoc 10 MyLineDef)))
    (if (= (cdr (assoc 0 MyLineDef)) "LINE")
      (setq MyLineEndB (cdr (assoc 11 MyLineDef)))
      (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef))))
    )
  ;;sort trimpts according to distance from end A
    (setq Pt1Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt1 "nea")) )
    (setq Pt2Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt2 "nea")) )
    (if ( > Pt1Dist Pt2Dist)
      (progn
        (setq TempPt TrimPt1)
        (setq TrimPt1 TrimPt2)
        (setq TrimPt2 TempPt)
      ) ;end progn
    ) ;end if
    (BAP MyLine TrimPt1)
    (setq MyLineA (entlast))
    (BAP MyLineA TrimPt2)
    (setq MyLineB (entlast))
    (entdel MyLineA)
    (command "zoom" "Previous")
    (command "zoom" "Previous")
    MyLineA
  )

;; add here something nice like "select lines or [option]"
;; Also add here something nice to remember value from last time
  (setq chdist 5)
  (setq chdist (getreal (strcat "Enter Chamfer Distance: " (rtos chdist))))
  (if (or (= chdist 0)(= chdist nil))(setq chdist 5))
  (setq coords1 (test "\nSelect Line or segment 1: "))
  (setq pline1 (car (last coords1)))

  (cond
    ( (= (cdr (assoc 0 (entget pline1))) "LINE")
      (setq MyType "Line")
      (setq chdisttemp 0)
      (command "chamfer" (cadr (last coords1)) "Distance" chdisttemp chdisttemp (setq pt (getpoint)) )
      (setq pline2 (nentselp pt))
      (setq NL1 (makeline (car coords1)(cadr coords1)) )
      (setq NL2 (makeline (cdr (assoc 10 (entget (car pline2)))) (cdr (assoc 11 (entget (car pline2)))) ))
    )
    ((= (cdr (assoc 0 (entget pline1))) "LWPOLYLINE")
      (setq MyType "Polyline")
      (setq coords2 (test "\nSelect Line or segment 2: "))
      (setq pline2 (car (last coords2)))
      (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
      (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
    )
    (t
      (princ "Can't do a mix of lines... just now")
      (setq MyType "Mix")
    )
  ) ; end conds

  (command "chamfer" NL1 "Distance" chdist chdist NL2)
  (setq NL3 (entlast))
  (setq NL3PtA (cdr (assoc 10 (entget NL3))) )
  (setq NL3PtB (cdr (assoc 11 (entget NL3))) )
  (command "move" NL1 "" NL3PtA NL3PtB )
  (command "move" NL2 "" NL3PtB NL3PtA )

  (cond
    ((= MyType "Line")
      (command "extend" NL1 NL2 "" NL1 NL2 "")
      (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) )
      (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int)))
      (entdel NL1)
      (entdel NL2)
      (setq NL1 (makeline ptsa NL3PtA) ); templine 3
      (setq NL2 (makeline ptsa NL3PtB) ); templine 4
      (entdel NL3)
      (command "chamfer" NL1 "Distance" chdisttemp chdisttemp pline1)
      (command "chamfer" NL2 "Distance" chdisttemp chdisttemp pline2)
    )
    ((= MyType "Polyline")
      (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) )
      (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int)))
      (entdel NL1)
      (entdel NL2)
      (setq NL1 (makeline ptsa NL3PtA) ); templine 3
      (setq NL2 (makeline ptsa NL3PtB) ); templine 4
      (entdel NL3)
      (trimlinetopt pline1 NL3PtA NL3PtB)
      (command "join" pline1 (entlast) NL1 NL2 "")
    )
  ) ; end conds

  (princ)
)

 

 

 

sweet! this one is way better! thanks a lot for this. it's almost perfect! great job steven!

Steven P Grand Master

Steven P

Posted
Posted

Only got to apologise for posting loads of posts on this thread.... It is nearly where I am happy with it and I'll maybe have another go to make it so.

  • Like 2
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

I did not post anything but thought about it, make sure line/pline are filleted, then make a circle at end pt, use this with intersectwith to get the 2 points intersecting, can use these points to work out the rest. (ssget pt) etc. Just a suggestion.

 

Oh yeah a thought a pline&line join together, a line&line again join, then only need 1 routine as its always a pline corner.

Edited by BIGAL
  • Like 1
Steven P Grand Master

Steven P

Posted
Posted (edited)

Had another look at this, happier with it now.

 

A question though, does anyone know the variable name for the standard chamfer distance - was thinking to use that and update that for the chamfer distance in here.

 

  

(defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa)
  ;;https://forums.autodesk.com/t5/autocad-forum/break-at-point/td-p/7553581
  (defun BAP ( entity point /)
    (setq entity (list entity point)) ; recreate entsel.... Added this line
    (command "_.break" entity "_F" "_non" point "_non" point)
  )
  (defun MakeLine ( con10 con11 /  )
    (entmakex (append (list (cons 0 "LINE")
                            (cons 100 "AcDbEntity")
                            (cons 100 "AcDbLine")
                            (cons 10 con10)
                            (cons 11 con11)
              ))
    )
  )
  ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/select-polyline-segment/td-p/1758253
  (defun test ( pt / elst ename pt param preparam postparam) ; returns selected line coordinates
    (setq elst (nentselp pt))
    (if (= (cdr (assoc 0 (entget (car elst)))) "LINE")
      (progn
        (list (cdr (assoc 10 (entget (car elst))))(cdr (assoc 11 (entget (car elst)))) elst)
      ) ; end progn
      (progn
        (setq ename (car elst))
        (setq pt (cadr elst))
        (setq pt (vlax-curve-getClosestPointTo ename pt))
        (setq param (vlax-curve-getParamAtPoint ename pt))
        (setq preparam (fix param))
        (setq postparam (1+ preparam))
        (list
          (vlax-curve-getPointAtParam ename preparam)
          (vlax-curve-getPointAtParam ename postparam)
          elst
        )
      ) ; end progn
    ) ; end if
  )
  (defun trimlinetopt ( MyLine TrimPt1 TrimPt2 /  MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPT MyLineA MyLineB)
    (command "zoom" "Object" MyLine "")
    (command "zoom" "0.95x")
    (setq MyLineDef (entget MyLine))
    (setq MyLineEndA (cdr (assoc 10 MyLineDef)))
    (if (= (cdr (assoc 0 MyLineDef)) "LINE")
      (setq MyLineEndB (cdr (assoc 11 MyLineDef)))
      (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef))))
    )
  ;;sort trimpts according to distance from end A
    (setq Pt1Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt1 "nea")) )
    (setq Pt2Dist (vlax-curve-getdistatpoint MyLine (osnap TrimPt2 "nea")) )
    (if ( > Pt1Dist Pt2Dist)
      (progn
        (setq TempPt TrimPt1)
        (setq TrimPt1 TrimPt2)
        (setq TrimPt2 TempPt)
      ) ;end progn
    ) ;end if
    (BAP MyLine TrimPt1)
    (setq MyLineA (entlast))
    (BAP MyLineA TrimPt2)
    (setq MyLineB (entlast))
    (entdel MyLineA)
    (command "zoom" "Previous")
    (command "zoom" "Previous")
    MyLineA
  )

;;; add here something nice like "select lines or [option]"
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark thisdrawing)
  (setq chdist (getreal (strcat "Enter Chamfer Distance (" (rtos (getvar "CHAMFERA")) "): ")))
  (if (= chdist nil)
    (setq chdist (getvar "CHAMFERA"))
    (progn (setvar "chamfera" chdist) (setvar "chamferb" chdist) )
  )

  (setq pt1 (cadr (entsel "\nSelect Line or Segment 1")))
  (setq coords1 (test pt1))
  (setq pline1 (car (last coords1)))

  (setq chdisttemp 0)
  (princ "Select Line or Segment 2")
  (command "chamfer" (cadr (last coords1)) "Distance" chdisttemp chdisttemp (setq pt2 (getpoint)) )
  (setq coords2 (test pt2))
  (setq pline2 (car (last coords2)))

  (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
  (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2

;;  (command "chamfer" NL1 "Distance" chdist chdist NL2)
  (command "chamfer" pt1 "Distance" chdist chdist pt2)

  (setq NL3 (entlast))
  (setq NL3PtA (cdr (assoc 10 (entget NL3))) )
  (setq NL3PtB (cdr (assoc 11 (entget NL3))) )
  (command "move" NL1 "" NL3PtA NL3PtB )
  (command "move" NL2 "" NL3PtB NL3PtA )

  (if (and (= (cdr (assoc 0 (entget pline1))) "LINE") (= (cdr (assoc 0 (entget pline2))) "LINE"))
    (setq MyType "Line")
    (setq MyType "Polyline")
  ) ; end if

  (command "extend" NL1 NL2 "" NL1 NL2 "")
  (setq int (vLa-intersectwith (vLax-ename->vLa-Object NL1) (vLax-ename->vLa-Object NL2) acextendnone) )
  (setq ptsa (vLax-safearray->List (vLax-variant-vaLue int)))
  (entdel NL1)
  (entdel NL2)
  (setq NL1 (makeline ptsa NL3PtA) ); templine 3
  (setq NL2 (makeline ptsa NL3PtB) ); templine 4
  (entdel NL3)

  (cond
    ((= MyType "Line")
      (command "chamfer" NL1 "Distance" chdisttemp chdisttemp pline1)
      (command "chamfer" NL2 "Distance" chdisttemp chdisttemp pline2)
    )
    ((= MyType "Polyline")
      (setq coords1 (test pt1))
      (setq pline1 (car (last coords1)))
      (trimlinetopt pline1 NL3PtA NL3PtB)
      (command "join" pline1 (entlast) NL1 NL2 "")
    )
  ) ; end conds

  (setvar "chamfera" chdist)
  (setvar "chamferb" chdist)

  (vla-endundomark thisdrawing)
  (princ)
)

 

Edited by Steven P
  • Like 1
devitg Experienced

devitg

Posted
Posted
On 2/8/2023 at 6:17 AM, tefached2809 said:

hi thanks for this, it worked really well however is there a possibility to do it without me picking the corner? just how chamfer works if the lines do not intersect on the corner yet it extends the line up to the notch,

 

but regardless, i already appreciate your help.

From 
® 2004.06.26, Stig Madsen v.0.95

CHAMFERA
chamfer,distance,fillet
Read-write,Real,Drawing
0.5000
Sets the first chamfer distance.
0
CHAMFERB
chamfer,distance,fillet
Read-write,Real,Drawing
0.5000
Sets the second chamfer distance.
0
CHAMFERC
chamfer,lenght,fillet
Read-write,Real,Drawing
1.0000
Sets the chamfer length.
0
CHAMFERD
chamfer,angle,fillet
Read-write,Real,Drawing
0.0000
Sets the chamfer angle.
0
CHAMMODE
chamfer,distance,angle
Read-write,Integer,Not saved
0
Sets the input method by which AutoCAD creates chamfers.
2
#0,Requires two chamfer distances
#1,Requires one chamfer distance and an angle 

  • Like 1
Steven P Grand Master

Steven P

Posted
Posted

Edited the code above with Devtigs suggestion. Am happy with this now... mostly....

 

(apart from a "select line or enter [D]istance" type of thing but that can be another day)

tefached2809 Apprentice

tefached2809

Posted
  • Author
Posted
1 hour ago, Steven P said:

Edited the code above with Devtigs suggestion. Am happy with this now... mostly....

 

(apart from a "select line or enter [D]istance" type of thing but that can be another day)

wow! man you have done it! it is perfect! thank you so much, slow claps to you sir!

  • Like 1

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...