Topic: About chamfer

[liuhaixin88]

Hi,guys
Once again to disturb.I'm so sorry!

shaft and hole chamfer, Choose three sides automatic chamfering,

[liuhaixin88]

Here is a Dcl template,

Code: [Select]

chamfer:dialog
{
  label="shaft / hole chamfer ";
  :boxed_row
  {
    label="stype";
    width=5;
    :radio_button
    {
      label="Hole chamfer";
      key="HC";
      value=1;
      width=2;
    }
    :radio_button
    {
      label="Shaft chamfer";
      key="FC";
      value=0;
      width=2;
    }
  }
  :row
  {
    :edit_box
    {
      label="Distance";
      key="DST";
      width=9;
      value="5";
      allow_accept=true;
    }
    :edit_box
    {
      label="Angle";
      key="ANG";
      width=9;
      value="45";
      allow_accept=true;
    }
  }
  spacer;
  ok_cancel;
}


[Lee Mac]

What's wrong with the CHAMFER command?

[liuhaixin88]

shaft chamfer must to connect a line,hole chamfer ?con't to do.

[liuhaixin88]

What's wrong with the CHAMFER command?

Thanks, lee

If use chamfer command ,shaft chamfer must to connect a line.

If use chamfer command, hole chamfer ?con't to do.

[Kerry]

Chamfer command can be run in NoTrim mode, so the internal chamfer can be done without removing the end line.
Get to know your drafting package before you ask others to modify it for you.

[liuhaixin88]

Chamfer command can be run in NoTrim mode, so the internal chamfer can be done without removing the end line.
Get to know your drafting package before you ask others to modify it for you.

Thanks ,I think use lisp can save a little time.

[Kerry]

Chamfer command can be run in NoTrim mode, so the internal chamfer can be done without removing the end line.
Get to know your drafting package before you ask others to modify it for you.

Thanks ,I think use lisp can save a little time.

It saves about 1.5  seconds

This Works in World UCS

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun c:doCounterBore (/          *error*    _entmakeOneLine       acadApp
3.                acadDoc    osmode     angle_bore angle_end  chamfer_distance
4.                layer      line0      line1      line2      osmode
5.                pt1        pt11       pt12       pt2        pt21
6.                pt22       selpt0     selpt1     selpt2     ss
7.               )
8.   ;; CodeHimBelonga kdub@theSwamp 2014.04.28
9.   (defun *error* (msg)
10.     (and msg
11.          (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
12.          (princ (strcat "\nError: " msg))
13.          (vl-bt)
14.     )
15.     (setvar "OSMODE" osmode)
16.     (vla-endundomark acadDoc)
17.     (princ)
18.   )
19.   ;;---
20.   ;;  
21.   (defun _entmakeOneLine (sp ep la /)
22.     (entmakex (list '(0 . "LINE")
23.                     '(100 . "AcDbLine")
24.                     (cons 8 la)
25.                     (cons 10 (trans sp acucs acworld))
26.                     (cons 11 (trans ep acucs acworld))
27.                     (cons 210 (trans '(0 0 1) 1 0 t))
28.               )
29.     )
30.   )
31.   ;;---
32.   (setq acadApp (vlax-get-acad-object)
33.         acadDoc (vla-get-activedocument acadApp)
34.         osmode  (getvar "OSMODE")
35.   )
36.   (vla-endundomark acadDoc)
37.   (vla-startundomark acadDoc)
38.   ;;---
39.   (if
40.     (and
41.       (setvar "OSMODE" 512)
42.       (setq selpt0 (kdub:sgp "Select shaft End line (nea)" nil nil))
43.       (setq ss (ssget selpt0 '((0 . "LINE"))))
44.       (setq line0 (vlax-ename->vla-object (ssname ss 0)))
45.       (setvar "OSMODE" 512)
46.       (setq selpt1 (kdub:sgp "Select Shaft Bore FIRST line (nea)" nil nil))
47.       (setq ss (ssget selpt1 '((0 . "LINE"))))
48.       (setq line1 (vlax-ename->vla-object (ssname ss 0)))
49.       (setvar "OSMODE" 128)
50.       (setq selpt2 (kdub:sgp "Select Shaft Bore SECOND line (per)" nil selpt1))
51.       (setq ss (ssget selpt2 '((0 . "LINE"))))
52.       (setq line2 (vlax-ename->vla-object (ssname ss 0)))
53.       (setvar "OSMODE" 0)
54.       (setq chamfer_Distance (getdist "\nChamfer distance: "))
55.     )
56.      (princ)
57.      (progn (alert "Invalid Input\nRoutine will EXIT") (exit))
58.   )
59.   ;;---
60.   (setq pt1        (vlax-invoke line1 'IntersectWith line0 acextendthisentity)
61.         pt2        (vlax-invoke line2 'IntersectWith line0 acextendthisentity)
62.         angle_end  (angle pt1 pt2)
63.         angle_bore (angle pt1 selpt1)
64.         pt11       (polar pt1 angle_bore chamfer_Distance)
65.         pt12       (polar pt1 angle_end (- chamfer_Distance))
66.         pt21       (polar pt2 angle_bore chamfer_Distance)
67.         pt22       (polar pt2 angle_end chamfer_Distance)
68.         layer      (vla-get-layer line1)
69.   )
70.   (_entmakeOneLine pt12 pt11 layer)
71.   (_entmakeOneLine pt11 pt21 layer)
72.   (_entmakeOneLine pt21 pt22 layer)
73.   (if (= chamfer_Distance (distance pt11 (vlax-get line1 'StartPoint)))
74.     (vlax-put line1 'StartPoint pt11)
75.     (vlax-put line1 'EndPoint pt11)
76.   )
77.   (if (= chamfer_Distance (distance pt21 (vlax-get line2 'StartPoint)))
78.     (vlax-put line2 'StartPoint pt21)
79.     (vlax-put line2 'EndPoint pt21)
80.   )
81.   ;;---
82.   (*error* nil)
83.   (princ)
84. )
85. (princ)
86.  

[liuhaixin88]

Chamfer command can be run in NoTrim mode, so the internal chamfer can be done without removing the end line.
Get to know your drafting package before you ask others to modify it for you.

Thanks ,I think use lisp can save a little time.

It saves about 1.5  seconds

This Works in World UCS

Kerry, Thank you very much! but it have error , Lack function: KDUB:SGP

Code: [Select]

Command: doCounterBore
Error: no function definition: KDUB:SGP
Backtrace:
[0.55] (VL-BT)
[1.51] (*ERROR* "no function definition: KDUB:SGP")
[2.46] (_call-err-hook #<SUBR @2a64f370 *ERROR*> "no function definition:
KDUB:SGP")
[3.40] (sys-error "no function definition: KDUB:SGP")
:ERROR-BREAK.35 nil
[4.32] (#<SUBR @0d4055b4 null-fun-hk> "Select shaft End line (nea)" nil nil)
[5.26] (KDUB:SGP "Select shaft End line (nea)" nil nil)
[6.19] (C:DOCOUNTERBORE)
[7.15] (#<SUBR @2a64f424 -rts_top->)
[8.12] (#<SUBR @0d40535c veval-str-body> "(C:DOCOUNTERBORE)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
Command:

[Kerry]

Code - Auto/Visual Lisp: [Select]

1. (defun kdub:sgp (promptmsg      default        basepoint
2.                  /              initbit        promptmessage
3.                  initstring     keywordstring  returnvalue
4.                  parameterlist
5.                 )
6.   ;;------------------------------    
7.   (setq initbit       1
8.         promptmessage (strcat
9.                         "\n"
10.                         (cond (promptmsg)
11.                               ("Specify Point")
12.                         )
13.                         (if default
14.                           (progn (setq initbit (logand initbit (~ 1)))
15.                                  (if (= (type default) 'str)
16.                                    (strcat " <<" default ">>")
17.                                    ;;
18.                                    ;; else, assume it is a point .. user beware
19.                                    (strcat " <<"
20.                                            (kdub:ptos default nil nil)
21.                                            ">>"
22.                                    )
23.                                  )
24.                           )
25.                           ""
26.                         )
27.                         ": "
28.                       )
29.   )
30.   ;;------------------------------
31.   (initget initbit)
32.   (if (vl-catch-all-error-p
33.         (setq returnvalue (vl-catch-all-apply
34.                             'getpoint
35.                             (if basepoint
36.                               (list promptmessage basepoint)
37.                               (list promptmessage)
38.                             )
39.                           )
40.         )
41.       )
42.     ;; ESC was pressed.
43.     (setq returnvalue nil
44.           default nil
45.     )
46.   )
47.   (if returnvalue
48.     returnvalue
49.     default
50.   )
51. )
52.  
53.  
54. ;;;------------------------------------------------------------------
55. ;;;------------------------------------------------------------------

Code - Auto/Visual Lisp: [Select]

1. ;;;------------------------------------------------------------------
2. ;;;
3. ;;; kwb 20021103
4. ;;; KDUB:ptos (pt xmode xprec
5.  
6. ;; Return a point formatted as a string
7. ;; Arguments :
8. ;; pt       : point list
9. ;; xmode  : Units to use , can be nil
10. ;; xprec   : display precision to use , can be nil
11.  
12. (defun kdub:ptos (pt xmode xprec)
13.   (or xmode (setq xmode (getvar "LUNITS")))
14.   (or xprec (setq xprec (getvar "LUPREC")))
15.   (if pt
16.     (strcat (rtos (car pt) xmode xprec)
17.             ",  "
18.             (rtos (cadr pt) xmode xprec)
19.             ",  "
20.             (rtos (caddr pt) xmode xprec)
21.     )
22.   )
23. )
24.  
25. ;;;------------------------------------------------------------------
26. ;;;------------------------------------------------------------------
27.  

[liuhaixin88]

Kerry , Thanks for your hard work !!!
Suggestions：
1. Not all CHAMFER IS 45 degrees
2. Only can chamfer hole , shaft chamfer?
3. Only  support LINE , what about pline ? maybe use "rectang" draw this shaft.

I think this code will be better：


DCL file

Code: [Select]

chamfer:dialog
{
  label="shaft / hole chamfer ";
  :boxed_row
  {
    label="stype";
    width=5;
    :radio_button
    {
      label="Hole chamfer";
      key="HC";
      value=1;
      width=2;
    }
    :radio_button
    {
      label="Shaft chamfer";
      key="FC";
      value=0;
      width=2;
    }
  }
  :row
  {
    :edit_box
    {
      label="Distance";
      key="DST";
      width=9;
      value="5";
      allow_accept=true;
    }
    :edit_box
    {
      label="Angle";
      key="ANG";
      width=9;
      value="45";
      allow_accept=true;
    }
  }
  spacer;
  ok_cancel;
}
LISP file

Code: [Select]

(defun myerr(msg)
  (command "undo" "e")
  (setq *error* olderr)
)

(defun entmu()
  (setq data1 (subst (cons 10 strp1)(assoc 10 data1) data1))
  (setq data1 (subst (cons 11 p31)(assoc 11 data1) data1))
  (setq data2 (subst (cons 10 strp2)(assoc 10 data2) data2))
  (setq data2 (subst (cons 11 p32)(assoc 11 data2) data2))
  (entmod data1)
  (entmod data2)
  (entupd (car line1))
  (entupd (car line2))
)

(defun c:hsc(/ d a typ DLG_ID result line1 line2 data1 data2 selp1 selp2 end10 end11 end20 end21 strp1 strp2 endp1 endp2 ang1 ang2 angd1 angd2 p31 p32 p41 p42 p51 p52)
  (setq olderr *error*)
  (setq *error* myerr)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq d 5.0)
  (setq a 45.0)
  (setq typ "HC")
  (setq DLG_ID (load_dialog "hsc.dcl"))
  (new_dialog "chamfer" DLG_ID)
  (mode_tile "DST" 2)
  (action_tile "HC" "(setq typ $key)")
  (action_tile "FC" "(setq typ $key)")
  (action_tile "DST" "(setq d (atof $value))")
  (action_tile "ANG" "(setq a (atof $value))")
  (action_tile "accept" "(done_dialog 1)(setq result T)")
  (action_tile "cancel" "(done_dialog 0)")
  (start_dialog)
  (unload_dialog DLG_ID)
  (if result
    (progn
      (setq line1 (entsel))
      (setq data1 (entget (car line1)))
      (setq selp1 (cadr line1))
      (if (= (cdr (assoc 0 data1)) "LINE")
        (progn
          (setq end10 (cdr (assoc 10 data1)))
          (setq end11 (cdr (assoc 11 data1)))
          (if (> (distance selp1 end11)(distance selp1 end10))
            (setq strp1 end11 endp1 end10 ang1 (angle end10 end11))
            (setq strp1 end10 endp1 end11 ang1 (angle end11 end10))
          )
        )
      )
      (setq line2 (entsel))
      (setq data2 (entget (car line2)))
      (setq selp2 (cadr line2))
      (if (= (cdr (assoc 0 data2)) "LINE")
        (progn
          (setq end20 (cdr (assoc 10 data2)))
          (setq end21 (cdr (assoc 11 data2)))
          (if (> (distance selp2 end21)(distance selp2 end20))
            (setq strp2 end21 endp2 end20 ang2 (angle end20 end21))
            (setq strp2 end20 endp2 end21 ang2 (angle end21 end20))
          )
        )
      )
      (setq angd1 (angle endp1 endp2))
      (setq angd2 (angle endp2 endp1))
      (if (or (= (abs (fix (* (- angd1 ang1) 10000))) 15707)(= (abs (fix (* (- angd2 ang2) 10000))) 15707))
        (progn
          (setq p31 (polar endp1 ang1 d))
          (setq p32 (polar endp2 ang2 d))
          (setq p41 (polar p31 (+ ang1 pi (* (/ a 180.0) pi))(/ d (cos (* (/ a 180.0) pi)))))
          (setq p42 (polar p32 (- ang2 pi (* (/ a 180.0) pi))(/ d (cos (* (/ a 180.0) pi)))))
          (setq p51 (polar p31 (- ang1 pi (* (/ a 180.0) pi))(/ d (cos (* (/ a 180.0) pi)))))
          (setq p52 (polar p32 (+ ang2 pi (* (/ a 180.0) pi))(/ d (cos (* (/ a 180.0) pi)))))
          (cond
    (
      (and (= typ "FC")
   (< (distance p31 endp1)(distance strp1 endp1))
   (< (distance p32 endp2)(distance strp2 endp2))
   (< (/ (* d (sin (* (/ a 180.0) pi)) 2.0)(cos (* (/ a 180.0) pi)))(distance endp1 endp2))
      )
      (progn
                (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p32)))
                (if (< (distance p41 p42)(distance p51 p52))
                  (progn
                    (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p41)))
                    (entmake (list '(0 . "LINE")(cons 10 p32)(cons 11 p42)))
    (entmake (list '(0 . "LINE")(cons 10 p41)(cons 11 p42)))
          )
                  (progn
                    (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p51)))
                    (entmake (list '(0 . "LINE")(cons 10 p32)(cons 11 p52)))
    (entmake (list '(0 . "LINE")(cons 10 p51)(cons 11 p52)))
  )
                )
(entmu)
      )
    )
    (
      (and (= typ "HC")
   (< (distance p31 endp1)(distance strp1 endp1))
   (< (distance p32 endp2)(distance strp2 endp2))
      )
      (progn
                (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p32)))
                (if (> (distance p41 p42)(distance p51 p52))
                  (progn
                    (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p41)))
                    (entmake (list '(0 . "LINE")(cons 10 p32)(cons 11 p42)))
                  )
                  (progn
                    (entmake (list '(0 . "LINE")(cons 10 p31)(cons 11 p51)))
                    (entmake (list '(0 . "LINE")(cons 10 p32)(cons 11 p52)))
  )
)
(entmu)
              )
    )
          )
        )
      )
    )
  )
  (myerr)
  (princ)
)
Defects
1. Not support PLINE too.
2. When chamfer shaft will be problems, End line not Trim, (See picture)


=================================================================================

[CAB]

Here is a very old Lisp.
http://www.theswamp.org/index.php?topic=17392.msg217642#msg217642

[GDF]

I use an old dialog box routine with preset values or slider control values to set the following distances:

Set Chamfer A =
Set Chamfer B =

[liuhaixin88]

I use an old dialog box routine with preset values or slider control values to set the following distances:

Set Chamfer A =
Set Chamfer B =

Nice tool !