Topic: Remove Chamfers from Polylines

[cmwade77]

I honestly am not sure where to start on this one, let's say I have a polyline with chamfers, I want to remove the chamfers, essentially restoring the polyline to what it was before using the chamfer command. I have thought about simply saving extended data to the entity of what the original vertexes were, but the problem with that approach would be if the polyline has been modified after adding the chamfers, then you would also loose those edits.

I am thinking I would have to specify a maximum chamfer size to remove, but beyond that, I am at a loss.

[kdub_nz]

Perhaps ( unless you have hundreds )

CHAMFER command
set trim mode to TRIM
set distance to 0, 0

select 2 segments to join.
. . . The segments join at their imaginary inter' and the chamfer is removed.

//---
Or use the FILLET command with TRIM mode and no radius , selecting the segments.

// -- even if you have multiple segments, this will still be pretty fast.

[cmwade77]

Ok, let me reword this, I want to select multiple polylines that may have hundreds of chamfers all at once and have it remove the chamfers automatically. Similar to what it would do with the fillet command and setting a radius of 0 and doing fillet polyline. I have made a routine that handles the fillets.

[mhupp]

assumes your chamfers are the smallest segments in the polyline.

Code - Auto/Visual Lisp: [Select]

1. ;;----------------------------------------------------------------------------;;
2. ;; REMOVE CHAMFERS
3. (defun C:foo (/ SS SS1 d objs fo)
4.   (setq SS1 (ssadd))
5.   (setq d (getdist (strcat "\nChamfer Distance: ")))
6.   (if (setq SS (ssget '((0 . "*POLYLINE") (70 . 1))))
7.     (progn
8.       (setq LastEnt (entlast))
9.       (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
10.         (setq objs (vlax-invoke (vlax-ename->vla-object poly) 'explode)
11.               fo (vlax-vla-object->ename (car objs))
12.         )
13.         (entdel poly)
14.         (foreach line objs
15.           (if (and (eq (vla-get-entityname line) "AcDbLine") (<= (vlax-get line 'Length) d))
16.             (progn
17.               (vla-delete line)
18.               (setq objs (vl-remove line objs))
19.             )
20.           )
21.         )
22.         (setvar 'filletrad 0)
23.         (while (> (length objs) 1)
24.           (setq leg1 (vlax-vla-object->ename (car objs)))
25.           (setq leg2 (vlax-vla-object->ename (cadr objs)))
26.           (vl-cmdf "_.fillet" leg1 leg2)
27.           (setq objs (cdr objs))
28.         )
29.         (vl-cmdf "_.fillet" leg2 fo)
30.       )
31.     )
32.   )
33.   (if (setq en (entnext LastEnt))
34.     (while en
35.       (ssadd en SS1)
36.       (setq en (entnext en))
37.     )
38.   )
39.   (vl-cmdf "_.Join" SS1 "")
40.   (princ)
41. )

[ribarm]

Code - Auto/Visual Lisp: [Select]

1. ;;-------------------------------------------------------------------------------------;;
2. ;; REMOVE CHAMFERS - Dedicated topic : http://www.theswamp.org/index.php?topic=57476.0 ;;
3. ;;-------------------------------------------------------------------------------------;;
4. ;; Orginal routine by : @mhupp ; Mod. by : @ribarm ; DATE : 01.April.2022.             ;;
5. ;;-------------------------------------------------------------------------------------;;
6.  
7. (defun C:rem_chamfers ( / *error* fillrad cmde d SS polys LastEnt objs fo leg1 leg2 SS1 en )
8.  
9.   (vl-load-com)
10.  
11.   (defun *error* ( m )
12.     (if command-s (command-s "_.UNDO" "_E") (vl-cmdf "_.UNDO" "_E"))
13.     (if cmde (setvar 'cmdecho cmde))
14.     (if fillrad (setvar 'filletrad fillrad))
15.     (if m (prompt m))
16.     (princ)
17.   )
18.  
19.   (setq fillrad (getvar 'filletrad))
20.   (setvar 'filletrad 0)
21.   (setq cmde (getvar 'cmdecho))
22.   (setvar 'cmdecho 0)
23.   (if (= 8 (logand 8 (getvar 'undoctl)))
24.     (vl-cmdf "_.UNDO" "_E")
25.   )
26.   (vl-cmdf "_.UNDO" "_G")
27.   (if
28.     (and
29.       (not (initget 6))
30.       (setq d (getdist "\nChamfer Distance : "))
31.       (if (setq SS (ssget "_:L" '((0 . "*POLYLINE")))) ;; this is different - added "_:L" to (ssget) and removed (70 . 1) from filtering ;;
32.         (setq polys
33.           (vl-remove-if-not
34.             (function
35.               (lambda ( pol / endpar pars )
36.                 (setq endpar (vlax-curve-getendparam pol))
37.                 (<
38.                   1
39.                   (length
40.                     (vl-remove nil
41.                       (mapcar
42.                         (function
43.                           (lambda ( par )
44.                             (equal
45.                               (distance (vlax-curve-getpointatparam pol par) (vlax-curve-getpointatparam pol (1- par)))
46.                               (- (vlax-curve-getdistatparam pol par) (vlax-curve-getdistatparam pol (1- par)))
47.                               1e-6 ;; fuzz - mod. to suit (tolerance for checking of existance of straight segment in reference checking polyline - pol) ;;
48.                             )
49.                           )
50.                         )
51.                         (repeat (1- (setq endpar (1+ (fix endpar)))
52.                           (setq pars (append pars (list (setq endpar (1- endpar)))))
53.                         )
54.                       )
55.                     )
56.                   )
57.                 ) ;; there were more than 1 straight segment detected in reference checking polyline - pol ;;
58.               )
59.             )
60.             (vl-remove-if (function listp)
61.               (mapcar (function cadr)
62.                 (ssnamex SS)
63.               )
64.             )
65.           )
66.         )
67.       )
68.     )
69.     (foreach poly polys
70.       (setq LastEnt (entlast))
71.       (setq objs (vlax-invoke (vlax-ename->vla-object poly) 'explode)
72.             fo (vlax-vla-object->ename (car objs))
73.       )
74.       (entdel poly)
75.       (foreach seg objs
76.         (cond
77.           ( (and (= (vla-get-entityname seg) "AcDbLine") (<= (vlax-get seg 'Length) d))
78.             (vla-delete seg)
79.             (setq objs (vl-remove seg objs))
80.           )
81.           ( (= (vla-get-entityname seg) "AcDbArc") ;; this is different - removing possible ARC occurences (not all segments are straight) ;;
82.             (vla-delete seg)
83.             (setq objs (vl-remove seg objs))
84.           )
85.         )
86.       )
87.       (while (> (length objs) 1)
88.         (setq leg1 (vlax-vla-object->ename (car objs)))
89.         (setq leg2 (vlax-vla-object->ename (cadr objs)))
90.         (vl-cmdf "_.FILLET" leg1 leg2)
91.         (setq objs (cdr objs))
92.       )
93.       (vl-cmdf "_.FILLET" leg2 fo)
94.       (setq SS1 (ssadd))
95.       (if (setq en (entnext LastEnt))
96.         (while en
97.           (ssadd en SS1)
98.           (setq en (entnext en))
99.         )
100.       )
101.       (initcommandversion) ;; perhaps this should be included - JOIN command is known for some poor operational processing ;;
102.       (vl-cmdf "_.JOIN" SS1 "")
103.     )
104.   )
105.   (*error* nil)
106. )
107.  

HTH. M.R.

[BIGAL]

I notice in both the code posted "explode" creeping in and not sure why if you have a pline with a short length then can find that segment so fillet segment-1 and segment+1, I do appreciate that Ribarm has taken into consideration that the segment may be an arc so would need to skip.

Will have a think about it. Can not do right now.