A MODIFIED CHAMFER FOR CUSTOM USE

February 7, 2023

hi can anyone help me make an autolisp command that makes a perpendicular line based on distance given instead of a diagonal line as shown in attached image

February 7, 2023

Are your original lines lines or polylines, or both? And do you have any sizes or the cut out, or like the regular chamfer do you want the user to enter a size as required?

(if it is just lines it is easier to do than polylines, but someone might have something that does this all ready)

February 7, 2023

hi, yes i want it to work on lines or poly lines just like how chamfer works, and i need to input the distance too, just like how chamfer works, but if it is easier on just lines i'll take that too.

February 7, 2023

Please test it for lines

notch-lines.LSP

February 7, 2023

Works for lines I think.

-EDITED FROM HERE-

This appears to work for Polylines - I haven't tested it fully and no error catching such as polyline segments shorter than the chamfer distance, or a full range of line angles. Could be made to work more like a regular chamfer, and perhaps could be called notchchamer as a LISP name, test wi;l do for now....

Should be able to be modified later to do lines and polylines

(defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa)
  (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 ( / elst ename pt param preparam postparam)
    (setq elst (entsel "\nSelect pline segment: "))
    (setq ename (car elst))
    (setq pt (cadr elst))
    (setq pt (vlax-curve-getClosestPointTo ename pt))
    (print (setq param (vlax-curve-getParamAtPoint ename pt)) )
    (print (setq preparam (fix param)) )
    (print (setq postparam (1+ preparam)) )
    (list
      (vlax-curve-getPointAtParam ename preparam)
      (vlax-curve-getPointAtParam ename postparam)
      elst
    )
  )
  (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
    (command "breakatpoint" MyLine TrimPt1)
    (setq MyLineA (entlast))
    (command "breakatpoint" 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 (getreal "Enter Chamfer Distance: "))
  (setq coords1 (test))
  (setq coords2 (test))
  (setq pline (car (last coords1)))
  (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
  (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
;  (setq chdist 25)
  (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 )

  (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 pline NL3PtA NL3PtB)
  (command "join" pline (entlast) NL1 NL2 "")

)

Edited February 7, 2023 by Steven P

February 7, 2023

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
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (initget 7)
  (setq chd (getdist "\nPick or specify chamfer distance : "))
  (prompt "\nSelect LWPOLYLINE(s) that are in unlocked Layer(s) and placed in WCS...")
  (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE"))))
    (progn
      (setq ti (car (_vl-times)))
      (repeat (setq i (sslength ss))
        (setq lw (ssname ss (setq i (1- i))))
        (if (vl-every (function (lambda ( x ) (if (= (car x) 42) (/= (cdr x) 0.0)))) (setq lwx (entget lw)))
          (prompt "\nLWPOLYLINE has only arced segments - unable to perform task... Processing next LWPOLYLINE...")
          (progn
            (setq data (vl-remove-if-not (function (lambda ( x ) (or (= (car x) 10) (= (car x) 42)))) lwx))
            (setq data
              (mapcar
                (function (lambda ( a b c d e f )
                  (if
                    (and
                      (= (cdr b) 0.0)
                      (= (cdr d) 0.0)
                    )
                    (list (cdr a) (cdr c) (cdr e) (angle (cdr c) (cdr a)) (angle (cdr c) (cdr e)))
                  )
                ))
                data
                (cdr data)
                (cddr data)
                (cdddr data)
                (cdr (cdddr data))
                (cddr (cdddr data))
              )
            )
            (setq data (vl-remove nil data))
            (mapcar
              (function (lambda ( x / aa bb ip )
                (exe (list "_.BREAK" (cadr x) (setq aa (polar (cadr x) (nth 3 x) chd))))
                (if
                  (and
                    lw
                    (not (vlax-erased-p lw))
                    (not (vl-position lw lil))
                  )
                  (setq lil (cons lw lil))
                  (setq lil (cons (entlast) lil))
                )
                (setq lil (cons (entlast) lil))
                (exe (list "_.BREAK" (cadr x) (setq bb (polar (cadr x) (nth 4 x) chd))))
                (exe (list "_.LINE" aa
                            (setq ip
                              (inters
                                aa
                                (polar aa (+ (* 0.5 pi) (nth 3 x)) 1.0)
                                bb
                                (polar bb (+ (* 0.5 pi) (nth 4 x)) 1.0)
                                nil
                              )
                            ) ""
                     )
                )
                (setq lil (cons (entlast) lil))
                (exe (list "_.LINE" bb ip ""))
                (setq lil (cons (entlast) lil))
              ))
              data
            )
            (setq s (ssadd))
            (foreach li lil
              (ssadd li s)
            )
            (setq el (entlast))
            (exe (list "_.JOIN" s ""))
            (if (not (eq el (entlast)))
              (setq lwx (entget (setq lw (entlast))))
            )
          )
        )
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

HTH.

Regards, M.R.

February 8, 2023

17 hours ago, devitg said:

Please test it for lines

notch-lines.LSP 4.86 kB · 2 downloads

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.

February 8, 2023

16 hours ago, Steven P said:

Works for lines I think.

-EDITED FROM HERE-

This appears to work for Polylines - I haven't tested it fully and no error catching such as polyline segments shorter than the chamfer distance, or a full range of line angles. Could be made to work more like a regular chamfer, and perhaps could be called notchchamer as a LISP name, test wi;l do for now....

Should be able to be modified later to do lines and polylines

(defun c:test ( / chdist coords1 coords2 pline NL1 NL2 NL3 NL3PtA NL3 PtB int ptsa)
  (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 ( / elst ename pt param preparam postparam)
    (setq elst (entsel "\nSelect pline segment: "))
    (setq ename (car elst))
    (setq pt (cadr elst))
    (setq pt (vlax-curve-getClosestPointTo ename pt))
    (print (setq param (vlax-curve-getParamAtPoint ename pt)) )
    (print (setq preparam (fix param)) )
    (print (setq postparam (1+ preparam)) )
    (list
      (vlax-curve-getPointAtParam ename preparam)
      (vlax-curve-getPointAtParam ename postparam)
      elst
    )
  )
  (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
    (command "breakatpoint" MyLine TrimPt1)
    (setq MyLineA (entlast))
    (command "breakatpoint" 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 (getreal "Enter Chamfer Distance: "))
  (setq coords1 (test))
  (setq coords2 (test))
  (setq pline (car (last coords1)))
  (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
  (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
;  (setq chdist 25)
  (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 )

  (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 pline NL3PtA NL3PtB)
  (command "join" pline (entlast) NL1 NL2 "")

)

thank you i tested this too and it worked up to the point that it makes the notch but somehow i got error on "breakatpoint" unknown command

and if working on polyline is hard, even if just lines it is ok for me

February 8, 2023

10 hours ago, marko_ribar said:

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
          (not
            (and
              (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6)
              (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6)
              (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6)
            )
          )
          (exe (list "_.UCS" "_P"))
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if initvalueslst
      (mapcar (function apply_cadr->car) initvalueslst)
    )
    (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa))
      (setq fun nil)
    )
    (if doc
      (vla-regen doc acactiveviewport)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;;

    (defun vl-load nil
      (or cad
        (if vlax-get-acad-object
          (setq cad (vlax-get-acad-object))
          (progn
            (vl-load-com)
            (setq cad (vlax-get-acad-object))
          )
        )
      )
      (or doc (setq doc (vla-get-activedocument cad)))
      (or alo (setq alo (vla-get-activelayout doc)))
      (or spc (setq spc (vla-get-block alo)))
    )

    ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;;
    (or (and cad doc alo spc) (vl-load))

    (defun exe ( tokenslist )
      ( (lambda ( tokenslist / ctch )
          (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t)))
            (progn
              (cmderr tokenslist)
              (catch_cont ctch)
            )
            (progn
              (while (< 0 (getvar (quote cmdactive)))
                (vl-cmdf "")
              )
              t
            )
          )
        )
        tokenslist
      )
    )

    (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;;
      (if command-s
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))
            ctch
          )
        )
        (if flag
          (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist))))
            flag
            ctch
          )
          (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist)))
            ctch
          )
        )
      )
    )

    (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;;
      (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist)))
    )

    (defun catch_cont ( ctch / gr )
      (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...")
      (while
        (and
          (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0)))))
          (setq gr (grread))
          (/= (car gr) 3)
          (not (equal gr (list 2 13)))
        )
      )
      (if (vl-catch-all-error-p ctch)
        ctch
      )
    )

    (defun apply_cadr->car ( sysvarvaluepair / ctch )
      (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair))
      (if (vl-catch-all-error-p ctch)
        (progn
          (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair))))
          (catch_cont ctch)
        )
      )
    )

    (defun ftoa ( n / m a s b )
      (if (numberp n)
        (progn
          (setq m (fix ((if (< n 0) - +) n 1e-8)))
          (setq a (abs (- n m)))
          (setq m (itoa m))
          (setq s "")
          (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0))))
            (setq s (strcat s (itoa b)))
            (setq a (- (* a 10.0) b))
          )
          (if (= (type n) (quote int))
            m
            (if (= s "")
              m
              (if (and (= m "0") (< n 0))
                (strcat "-" m "." s)
                (strcat m "." s)
              )
            )
          )
        )
      )
    )

    (setq sysvarpreset
      (list
        (list (quote cmdecho) 0)
        (list (quote 3dosmode) 0)
        (list (quote osmode) 0)
        (list (quote unitmode) 0)
        (list (quote cmddia) 0)
        (list (quote ucsvp) 0)
        (list (quote ucsortho) 0)
        (list (quote projmode) 0)
        (list (quote orbitautotarget) 0)
        (list (quote insunits) 0)
        (list (quote hpseparate) 0)
        (list (quote hpgaptol) 0)
        (list (quote halogap) 0)
        (list (quote edgemode) 0)
        (list (quote pickdrag) 0)
        (list (quote qtextmode) 0)
        (list (quote dragsnap) 0)
        (list (quote angdir) 0)
        (list (quote aunits) 0)
        (list (quote limcheck) 0)
        (list (quote gridmode) 0)
        (list (quote nomutt) 0)
        (list (quote apbox) 0)
        (list (quote attdia) 0)
        (list (quote blipmode) 0)
        (list (quote copymode) 0)
        (list (quote circlerad) 0.0)
        (list (quote filletrad) 0.0)
        (list (quote filedia) 1)
        (list (quote autosnap) 1)
        (list (quote objectisolationmode) 1)
        (list (quote highlight) 1)
        (list (quote lispinit) 1)
        (list (quote layerpmode) 1)
        (list (quote fillmode) 1)
        (list (quote dragmodeinterrupt) 1)
        (list (quote dispsilh) 1)
        (list (quote fielddisplay) 1)
        (list (quote deletetool) 1)
        (list (quote delobj) 1)
        (list (quote dblclkedit) 1)
        (list (quote attreq) 1)
        (list (quote explmode) 1)
        (list (quote frameselection) 1)
        (list (quote ltgapselection) 1)
        (list (quote pickfirst) 1)
        (list (quote plinegen) 1)
        (list (quote plinetype) 1)
        (list (quote peditaccept) 1)
        (list (quote solidcheck) 1)
        (list (quote visretain) 1)
        (list (quote regenmode) 1)
        (list (quote celtscale) 1.0)
        (list (quote ltscale) 1.0)
        (list (quote osnapcoord) 2)
        (list (quote grips) 2)
        (list (quote dragmode) 2)
        (list (quote lunits) 2)
        (list (quote pickstyle) 3)
        (list (quote navvcubedisplay) 3)
        (list (quote pickauto) 3)
        (list (quote draworderctl) 3)
        (list (quote expert) 5)
        (list (quote auprec) 6)
        (list (quote luprec) 6)
        (list (quote pickbox) 6)
        (list (quote aperture) 6)
        (list (quote osoptions) 7)
        (list (quote dimzin) 8)
        (list (quote pdmode) 35)
        (list (quote pdsize) -1.5)
        (list (quote celweight) -1)
        (list (quote cecolor) "BYLAYER")
        (list (quote celtype) "ByLayer")
        (list (quote clayer) "0")
      )
    )
    (setq sysvarlst (mapcar (function car) sysvarpreset))
    (setq sysvarvals (mapcar (function cadr) sysvarpreset))
    (setq sysvarvals
      (vl-remove nil
        (mapcar
          (function (lambda ( x )
            (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals))
          ))
          sysvarlst
        )
      )
    )
    (setq sysvarlst
      (vl-remove-if-not
        (function (lambda ( x )
          (getvar x)
        ))
        sysvarlst
      )
    )
    (setq initvalueslst
      (apply (function mapcar)
        (cons (function list)
          (list
            sysvarlst
            (mapcar (function getvar) sysvarlst)
          )
        )
      )
    )
    (apply (function mapcar)
      (cons (function setvar)
        (list
          sysvarlst
          sysvarvals
        )
      )
    )
    (while (= 8 (logand 8 (getvar (quote undoctl))))
      (if (not (exe (list "_.UNDO" "_E")))
        (if doc
          (vla-endundomark doc)
        )
      )
    )
    (if (not (exe (list "_.UNDO" "_M")))
      (if doc
        (vla-startundomark doc)
      )
    )
    (if wcs
      (if (= 0 (getvar (quote worlducs)))
        (progn
          (setq ucsf
            (list
              (getvar (quote ucsxdir))
              (getvar (quote ucsydir))
              (trans (list 0.0 0.0 1.0) 1 0 t)
            )
          )
          (exe (list "_.UCS" "_W"))
        )
      )
    )
    wcs
  )

  (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;;
  (initget 7)
  (setq chd (getdist "\nPick or specify chamfer distance : "))
  (prompt "\nSelect LWPOLYLINE(s) that are in unlocked Layer(s) and placed in WCS...")
  (if (setq ss (ssget "_:L" (list (cons 0 "LWPOLYLINE"))))
    (progn
      (setq ti (car (_vl-times)))
      (repeat (setq i (sslength ss))
        (setq lw (ssname ss (setq i (1- i))))
        (if (vl-every (function (lambda ( x ) (if (= (car x) 42) (/= (cdr x) 0.0)))) (setq lwx (entget lw)))
          (prompt "\nLWPOLYLINE has only arced segments - unable to perform task... Processing next LWPOLYLINE...")
          (progn
            (setq data (vl-remove-if-not (function (lambda ( x ) (or (= (car x) 10) (= (car x) 42)))) lwx))
            (setq data
              (mapcar
                (function (lambda ( a b c d e f )
                  (if
                    (and
                      (= (cdr b) 0.0)
                      (= (cdr d) 0.0)
                    )
                    (list (cdr a) (cdr c) (cdr e) (angle (cdr c) (cdr a)) (angle (cdr c) (cdr e)))
                  )
                ))
                data
                (cdr data)
                (cddr data)
                (cdddr data)
                (cdr (cdddr data))
                (cddr (cdddr data))
              )
            )
            (setq data (vl-remove nil data))
            (mapcar
              (function (lambda ( x / aa bb ip )
                (exe (list "_.BREAK" (cadr x) (setq aa (polar (cadr x) (nth 3 x) chd))))
                (if
                  (and
                    lw
                    (not (vlax-erased-p lw))
                    (not (vl-position lw lil))
                  )
                  (setq lil (cons lw lil))
                  (setq lil (cons (entlast) lil))
                )
                (setq lil (cons (entlast) lil))
                (exe (list "_.BREAK" (cadr x) (setq bb (polar (cadr x) (nth 4 x) chd))))
                (exe (list "_.LINE" aa
                            (setq ip
                              (inters
                                aa
                                (polar aa (+ (* 0.5 pi) (nth 3 x)) 1.0)
                                bb
                                (polar bb (+ (* 0.5 pi) (nth 4 x)) 1.0)
                                nil
                              )
                            ) ""
                     )
                )
                (setq lil (cons (entlast) lil))
                (exe (list "_.LINE" bb ip ""))
                (setq lil (cons (entlast) lil))
              ))
              data
            )
            (setq s (ssadd))
            (foreach li lil
              (ssadd li s)
            )
            (setq el (entlast))
            (exe (list "_.JOIN" s ""))
            (if (not (eq el (entlast)))
              (setq lwx (entget (setq lw (entlast))))
            )
          )
        )
      )
      (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...")
      (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...")
    )
  )
  (*error* nil)
)

HTH.

Regards, M.R.

thank you for this but i haven't tested it yet because it's giving me error variable setting rejected pickauto 3 i will try on a newer version

February 8, 2023

breakatpoint is a new command in Autocad.

So you need a recent Autocad version

February 8, 2023

Thanks Emmanuel, would have taken me ages to work that out!

Try this version with 'BAP' added to replace breakatpoint command

(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 (entsel))
  ;  (setq point (getpoint))
    (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 ( / elst ename pt param preparam postparam)
    (setq elst (entsel "\nSelect pline segment: "))
    (setq ename (car elst))
    (setq pt (cadr elst))
    (setq pt (vlax-curve-getClosestPointTo ename pt))
    (print (setq param (vlax-curve-getParamAtPoint ename pt)) )
    (print (setq preparam (fix param)) )
    (print (setq postparam (1+ preparam)) )
    (list
      (vlax-curve-getPointAtParam ename preparam)
      (vlax-curve-getPointAtParam ename postparam)
      elst
    )
  )
  (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
;    (command "breakatpoint" MyLine TrimPt1)

(princ MyLine)

    (BAP MyLine TrimPt1)
    (setq MyLineA (entlast))
;    (command "breakatpoint" MyLineA TrimPt2)
    (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 (getreal "Enter Chamfer Distance: "))
  (setq coords1 (test))
  (setq coords2 (test))
  (setq pline (car (last coords1)))
  (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
  (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
;  (setq chdist 25)
  (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 )

  (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 pline NL3PtA NL3PtB)
  (command "join" pline (entlast) NL1 NL2 "")

)

February 8, 2023

Should be easy to modify mine to do lines and polylines... might need a thought if 1 is a line, 1 is a polyline - will do something later for this

February 8, 2023

5 hours ago, Steven P said:

Thanks Emmanuel, would have taken me ages to work that out!

Try this version with 'BAP' added to replace breakatpoint command

(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 (entsel))
  ;  (setq point (getpoint))
    (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 ( / elst ename pt param preparam postparam)
    (setq elst (entsel "\nSelect pline segment: "))
    (setq ename (car elst))
    (setq pt (cadr elst))
    (setq pt (vlax-curve-getClosestPointTo ename pt))
    (print (setq param (vlax-curve-getParamAtPoint ename pt)) )
    (print (setq preparam (fix param)) )
    (print (setq postparam (1+ preparam)) )
    (list
      (vlax-curve-getPointAtParam ename preparam)
      (vlax-curve-getPointAtParam ename postparam)
      elst
    )
  )
  (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
;    (command "breakatpoint" MyLine TrimPt1)

(princ MyLine)

    (BAP MyLine TrimPt1)
    (setq MyLineA (entlast))
;    (command "breakatpoint" MyLineA TrimPt2)
    (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 (getreal "Enter Chamfer Distance: "))
  (setq coords1 (test))
  (setq coords2 (test))
  (setq pline (car (last coords1)))
  (setq NL1 (makeline (car coords1) (cadr coords1)) ); templine 1
  (setq NL2 (makeline (car coords2) (cadr coords2)) ); templine 2
;  (setq chdist 25)
  (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 )

  (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 pline NL3PtA NL3PtB)
  (command "join" pline (entlast) NL1 NL2 "")

)

this is really nice!
your version is the one closest to what i have in mind i did some tests and it is perfect on polylines however some cases i have lines as shown in the picture can you please consider it to be able to do them too just like how chamfer command works

February 8, 2023

6 hours ago, 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.

See attached

notch-lines-as-chamfer -do.LSP

February 8, 2023

5 minutes ago, devitg said:

See attached

notch-lines-as-chamfer -do.LSP 6.21 kB · 0 downloads

amazing!! thanks a lot for this this works perfectly on lines. much appreciated!!

February 8, 2023

Thanks.

Devitg has a solution there for lines but I might have a look - I reckon I can change my version around to do both - that work stuff is getting in the way today!!

(the pictures you show are the LISP working it out but hasn't quite been told what to do with lines)

Edited February 8, 2023 by Steven P

February 8, 2023

14 minutes ago, Steven P said:

Thanks.

Devitg has a solution there for lines but I might have a look - I reckon I can change my version around to do both - that work stuff is getting in the way today!!

(the pictures you show are the LISP working it out but hasn't quite been told what to do with lines)

that would be really great if it works on both,
oh sorry, i am bad in english so i try to show it visually, so i want it to work same as how chamfer would do it, for polylines or lines, so in some cases the lines are not yet meeting on corner the command extends it up to the notch, or in some cases the lines are already crossing on the corner so the command will trim the excess lines.
your version works really well if the project is already on polyline.

February 8, 2023

12 hours ago, 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.

See attached

Please show us some real and true sample.dwg .

I suppose this notch are cut to bend the metal or whatever material to become a 4 sided PAN from a Flat sheet .

If it is so the polylines will be closed.

But maybe despite it is closed, the notch could be at some , and not all corners .

February 8, 2023

here's an example, in some cases it's drawn in polyline, and sometimes only lines (and poorly drawn with gaps and extended lines) but the result is just the same be it closed or not. but it is still nice to have it work on polylines as well, anyway your LISP is great and i am using it now, i just need to explode the polyline to make it work.

SAMPLE.dwg

February 9, 2023

13 hours ago, tefached2809 said:

here's an example, in some cases it's drawn in polyline, and sometimes only lines (and poorly drawn with gaps and extended lines) but the result is just the same be it closed or not. but it is still nice to have it work on polylines as well, anyway your LISP is great and i am using it now, i just need to explode the polyline to make it work.

SAMPLE.dwg 165.39 kB · 4 downloads

I made something that I quite like. It works on your dwg example. It could use some work to make it more versatile.

- The code works only for polylines.

- Only for horizontal/vertical lines.

- There's hardly any error check. Use it as intended, or I don't know what will happen.

Command CCF

- user sets a distace dist1

- user selects the polyline

- Now pick corner points p1. don't pick the end of the polyline. It only expects corner points (best put on OSNAP)

- p1 now gets replaced by p2 p4 p3

I haven't looked well at the other replies. I'll just assume I did it a little different


(vl-load-com)

;; returns a list of coordinates. But we replace 1 coordinate by 3 points
(defun move_vertex_add_custom_chamfer ( lst ind p1 p2 p3  / new_lst i)
	(setq new_lst (list))
	(setq i 0)
	
	(repeat (/ (length lst) 2)
		(if (= i (* 2 ind))
			;; add the 3 points
			(setq new_lst (append new_lst (list (nth 0 p1) (nth 1 p1) (nth 0 p2) (nth 1 p2) (nth 0 p3) (nth 1 p3)  )))
			;; copy list
			(setq new_lst (append new_lst (list (nth i lst) (nth (+ i 1) lst) )))
		)
		(setq i (+ i 2))
	)
	new_lst

)

;; CCF for Custom ChamFer
(defun c:ccf ( / dist dist2 pline p1 param1 d1 p2 p3 ang1 ang2 coords)
	;; User enters the distance / offset
		(setq dist (getdist "\nDistance to custom chamfer: "))
	;; user selects polyline.  	
		(setq pline (car (entsel "\nSelect polyline: ")))
		(while (setq p1 (osnap (getpoint "\nSelect corner point: ") "_end"))  ;; select corner
			
			(setq param1 (vlax-curve-getParamAtPoint pline p1))
			;; d1 = the distance along the path of the polyline at p1
			(setq d1 (vlax-curve-getDistAtPoint pline p1))
			;; now p2 = d1 + offset distance, p1 = d1 - offset distance, 
			(setq p2 (vlax-curve-getPointAtDist pline (- d1 dist) ))
			(setq p3 (vlax-curve-getPointAtDist pline (+ d1 dist) ))
			
			;;;; now check the angles.
			;;;; angle from previous endpoint to p1
			;;(setq ang1 (angle 
			;;	(vlax-curve-getPointAtParam pline (- param1 1))
			;;	(vlax-curve-getPointAtParam pline param1)
			;;))
			;;
			;;	;; angle from p1 to newt endpoint 
			;;(setq ang2 (angle 
			;;	(vlax-curve-getPointAtParam pline (+ param1 1))
			;;	(vlax-curve-getPointAtParam pline param1)
			;;))
			
			;;  TODO: make this work for other angles; not just horizontal/vertical
			
			
			;; We look for p4, which cas 1 coordinate of p2 and 1 of p3
			(if (= (nth 0 p1) (nth 0 p2) )
				;; p1-p2 is horizontal, so we take y-value of p2 and x-value of p3
				(setq p4 (list (nth 0 p3) (nth 1 p2) ))
				;; else the opposite
				(setq p4 (list (nth 0 p2) (nth 1 p3) ))
			)
			
		;; read vertex coordinates; replace the selected point.	
			(setq coords (vlax-get (vlax-ename->vla-object pline) 'coordinates))
			;; Remove the chosen point, replace it by the 3 "chamfered" points
			(setq new_coords (move_vertex_add_custom_chamfer coords param1 p2 p4 p3))
			(vlax-put (vlax-ename->vla-object pline) 'coordinates new_coords)	;replace the coordinate list
		
		)
)

Edited February 9, 2023 by Emmanuel Delay

Sign In

A MODIFIED CHAMFER FOR CUSTOM USE

Recommended Posts

tefached2809

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

devitg

Steven P

marko_ribar

Posted Images

Steven P

tefached2809

devitg

Steven P

marko_ribar

tefached2809

tefached2809

tefached2809

Emmanuel Delay

Steven P

Steven P

tefached2809

devitg

tefached2809

Steven P

tefached2809

devitg

tefached2809

Emmanuel Delay

Join the conversation

devitg

Steven P

marko_ribar

Tutorials

Forums

Activity