Hello,
I'm doing something similar, converting lines into ARC's in a outline. I've created an own code but to make the running faster I need to reduce the number of vertexes.
I call at first the overkill command then the PLDiet.lisp to reduce the number of the vertexes. Overkill is needed because sometimes without it the PLD destroying the shape. I want to implement this as a SUBrutine in my file.
I've changed the PLD into a SUBrutine in a simple file - it works perfect.
(defun C:Test_PLD (/ ss x e)
(vl-load-com)
(setq ss nil)
(princ "\nPick a LWPOLYLINE")
(while (= ss nil)
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
) ;while
;;; (setq disttemp 5) ; Maximum distance between non-collinear vertices to straighten
;;; (setq cidtemp 10) ; Maximum change in direction to straighten
;;; (setq plsel ss) ; selection set
;;; (setq arctemp "R") ; selection set
(setq e (ssname ss 0))
(command "-overkill" e "" "p" "b" "no" "" "tolerance" 10 "")
;;; (command "-overkill" e "" "tolerance" 10 "" "p" "b" "no" "")
(setq x (DtR 5) )
(RDI:PLD 10.0 x "S" ss)
) ;defun
------------------------------------------
------------------------------------------
;;; PLDIET.lsp [command name: PLD]
;;; To put lightweight PolyLines on a DIET (remove excess vertices); usually
;;; used for contours with too many too-closely-spaced vertices.
;;; Concept from PVD routine [posted on AutoCAD Customization Discussion
;;; Group by oompa_l, July 2009] by Brian Hailey, added to by CAB, and
;;; WEED and WEED2 routines by Skyler Mills at Cadalyst CAD Tips [older
;;; routines for "heavy" Polylines that won't work on newer lightweight ones];
;;; simplified in entity data list processing, and enhanced in other ways [error
;;; handling, default values, join collinear segments beyond max. distance,
;;; limit to current space/tab, account for change in direction across 0 degrees,
;;; option to keep or eliminate arc segments] by Kent Cooper, August 2009.
;;; Last edited 28 August 2013
;;; input variables
;;; disttemp - Maximum distance between non-collinear vertices to straighten
;;; cidtemp - Maximum change in direction to straighten
;;; plsel - selection set, only LWPOLYLINE !
;;; arctemp - Retain or Straighten arc segments [R/S]
(defun RDI:PLD
(disttemp cidtemp arctemp plsel / *error* cmde disttemp cidtemp arctemp plinc plsel pl
pldata ucschanged front 10to42 vinc verts vert1 vert2 vert3)
;
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(if ucschanged (command "_.ucs" "_prev"))
; ^ i.e. don't go back unless routine reached UCS change but didn't change back
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
); end defun - *error*
;
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setq plinc 0)
;;; (setq
;;; disttemp
;;; (getdist
;;; (strcat
;;; "\nMaximum distance between non-collinear vertices to straighten"
;;; (if *distmax* (strcat " <" (rtos *distmax* 2 2) ">") ""); default only if not first use
;;; ": "
;;; ); end strcat
;;; ); end getdist & disttemp
;;;
;;; *distmax*
;;; (cond
;;; (disttemp); user entered number or picked distance
;;; (*distmax*); otherwise, user hit Enter - keep value
;;; ); end cond & *distmax*
;;;
;;; cidtemp
;;; (getangle
;;; (strcat
;;; "\nMaximum change in direction to straighten"
;;; (strcat ; offer prior choice if not first use; otherwise 15 degrees
;;; " <"
;;; (if *cidmax* (angtos *cidmax*) (angtos (/ pi 12)))
;;; ">"
;;; ); end strcat
;;; ": "
;;; ); end strcat
;;; ); end getdist & cidtemp
;;;
;;; *cidmax*
;;; (cond
;;; (cidtemp); user entered number or picked angle
;;; (*cidmax*); Enter with prior value set - use that
;;; ((/ pi 12)); otherwise [Enter on first use] - 15 degrees
;;; ); end cond & *cidmax*
;;;
;;; plinc 0 ; incrementer through selection set of Polylines
;;; ); end setq
;;; (initget "Retain Straighten")
;;; (setq
;;; arctemp
;;; (getkword
;;; (strcat
;;; "\nRetain or Straighten arc segments [R/S] <"
;;; (if *arcstr* (substr *arcstr* 1 1) "S"); at first use, S default; otherwise, prior choice
;;; ">: "
;;; ); end strcat
;;; ); end getkword
;;;
;;; *arcstr*
;;; (cond
;;; (arctemp); if User typed something, use it
;;; (*arcstr*); if Enter and there's a prior choice, keep that
;;; ("Straighten"); otherwise [Enter on first use], Straighten
;;; ); end cond & *arcstr*
;;; ); end setq
;
;;; (prompt "\nSelect LWPolylines to put on a diet, or press Enter to select all: ")
;;; (cond
;;; ((setq plsel (ssget '((0 . "LWPOLYLINE"))))); user-selected Polylines
;;; ((setq plsel (ssget "X" (list '(0 . "LWPOLYLINE") (cons 410 (getvar 'ctab))))))
;;; ; all Polylines [in current space/tab only]
;;; ); end cond
;
(repeat (sslength plsel)
(setq pl (ssname plsel plinc))
(while
(equal (vlax-curve-getStartPoint pl) (vlax-curve-getPointAtParam pl 1) 1e-6)
; to correct for possibility that more than one vertices at beginning coincide,
; in which case Pline does not define a CS under UCS OBject, causing error
(command "_.pedit" pl "_edit" "_straighten" "" "" "_go" "_exit" "")
); while
(setq pldata (entget pl))
(if (/= (cdr (last pldata)) (trans '(0 0 1) 1 0)); extr. direction not parallel current CS
; for correct angle & distance calculations [projected onto current construction
; plane], since 10-code entries for LWPolylines are only 2D points:
(progn
(command "_.ucs" "_new" "_object" pl) ; set UCS to match object
(setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't
); end progn
); end if
(setq
front ; list of "front end" [pre-vertices] entries, minus entity names & handle
(vl-remove-if
'(lambda (x)
(member (car x) '(-1 330 5 10 40 41 42 210))
); end lambda
pldata
); end removal & front
10to42 ; list of all code 10, 40, 41, 42 entries only
(vl-remove-if-not
'(lambda (x)
(member (car x) '(10 40 41 42))
); end lambda
pldata
); end removal & 10to42
vinc (/ (length 10to42) 4); incrementer for vertices within each Polyline
verts nil ; eliminate from previous Polyline [if any]
); end setq
(if (= *arcstr* "Straighten")
(progn
(setq bulges ; find any bulge factors
(vl-remove-if-not
'(lambda (x)
(and
(= (car x) 42)
(/= (cdr x) 0.0)
); end and
); end lambda
10to42
); end removal & bulges
); end setq
(foreach x bulges (setq 10to42 (subst '(42 . 0.0) x 10to42)))
; straighten all arc segments to line segments
); end progn
); end if
(repeat vinc
(setq
verts ; sub-group list: separate list of four entries for each vertex
(cons
(list
(nth (- (* vinc 4) 4) 10to42)
(nth (- (* vinc 4) 3) 10to42)
(nth (- (* vinc 4) 2) 10to42)
(nth (1- (* vinc 4)) 10to42)
); end list
verts
); end cons & verts
vinc (1- vinc) ; will be 0 at end
); end setq
); end repeat
(while (nth (+ vinc 2) verts); still at least 2 more vertices
(if
(or ; only possible if chose to Retain arc segments
(/= (cdr (assoc 42 (nth vinc verts))) 0.0); next segment is arc
(/= (cdr (assoc 42 (nth (1+ vinc) verts))) 0.0); following segment is arc
); end or
(setq vinc (1+ vinc)); then - don't straighten from here; move to next
(progn ; else - analyze from current vertex
(setq
vert1 (cdar (nth vinc verts)) ; point-list location of current vertex
vert2 (cdar (nth (1+ vinc) verts)); of next one
vert3 (cdar (nth (+ vinc 2) verts)); of one after that
ang1 (angle vert1 vert2)
ang2 (angle vert2 vert3)
); end setq
(if
(or
(equal ang1 ang2 0.0001); collinear, ignoring distance
(and
(<= (distance vert1 vert3) *distmax*)
; straightens if direct distance from current vertex to two vertices later is
; less than or equal to maximum; if preferred to compare distance along
; Polyline through intermediate vertex, replace above line with this:
; (<= (+ (distance vert1 vert2) (distance vert2 vert3)) *distmax*)
(<=
(if (> (abs (- ang1 ang2)) pi); if difference > 180 degrees
(+ (min ang1 ang2) (- (* pi 2) (max ang1 ang2)))
; then - compensate for change in direction crossing 0 degrees
(abs (- ang1 ang2)); else - size of difference
); end if
*cidmax*
); end <=
); end and
); end or
(setq verts (vl-remove (nth (1+ vinc) verts) verts))
; then - remove next vertext, stay at current vertex for next comparison
(setq vinc (1+ vinc)); else - leave next vertex, move to it as new base
); end if - distance & change in direction analysis
); end progn - line segments
); end if - arc segment check
); end while - working through vertices
(setq
front (subst (cons 90 (length verts)) (assoc 90 front) front)
; update quantity of vertices for front end
10to42 nil ; clear original set
); end setq
(foreach x verts (setq 10to42 (append 10to42 x)))
; un-group four-list vertex sub-lists back to one list of all 10, 40, 41, 42 entries
(setq pldata (append front 10to42 (list (last pldata))))
; put front end, vertex entries and extrusion direction back together
(entmake pldata)
(entdel pl); remove original
(setq plinc (1+ plinc)); go on to next Polyline
(if ucschanged
(progn
(command "_.ucs" "_prev")
(setq ucschanged nil) ; eliminate UCS reset in *error* since routine did it already
); end progn
); end if - UCS reset
); end repeat - stepping through set of Polylines
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); end defun - PLD
(prompt "\nType PLD to put PolyLines on a Diet.")
But if I want to use it in my program I get an error message: error: bad argument value: AcDbCurve 43
I cannot figure out why. Do someone has any idea ?
;;; This program goes thrugh a LWPOLYLINE and changes cearten 2 neabor lines into ARC
;;; So it will be more smooth
;;; If the program create an ARC makes it bold, so it good visible where was active
;;; Created by: Ákos Erdélyi
;;; v00: 2023.06.09.
;;; v001: overkill added
;;; v002: PLD as SUBrutine added
(defun C:Poly_curveing
(/ ss ; selection set
i ; counter, position in the POLYLINE
n ; length of the POLYLINE
n1 ; length of the modified POLYLINE
e ; name of the POLYLINE
p-0 ; actual point in the POLYLINE
p-1 ; previous point
p-2 ; second points back
p-3 ; therard points back
bulge-0 bulge-1 ; bulge
bulge-2 bulge-3 ; bulge
angle_1 angle_2 ; angle between the line segments
bulge ; bulge for the new ARC
alfa ;
min_angle ; The min. angle between two lines when the program works
max_angle ; The max. angle between two lines when the program works
max_length ; maximal segment length where the program perform the change
w ; width of the bold segments
a ; value for the length of the polyline 3 or 4
x ;
)
(vl-load-com)
(setq i 4
n 0
min_angle 0.3
max_angle 19
max_length 25
w 0.75
)
(setq ss nil)
(princ "\nPick a LWPOLYLINE")
(while (= ss nil)
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
) ;while
;;; (setq disttemp 10) ; Maximum distance between non-collinear vertices to straighten
;;; (setq cidtemp 5) ; Maximum change in direction to straighten
;;; (setq plsel ss) ; selection set
;;; (setq arctemp "R") ; selection set
(setq e (ssname ss 0))
;;; (command "-overkill" e "" "tolerance" 10 "")
(command "-overkill" e "" "p" "b" "no" "" "tolerance" 10 "")
(setq x (DtR 5) )
(RDI:PLD 10.0 x "S" ss)
(setq n (+ (fix (vlax-curve-getEndParam e)) 1))
;; Checking if the POLYLINE is closed or not
;; If it is open somehow a should be 3
;; If it is closed a should be 4 otherwise error: invalid index
(if (vlax-curve-isClosed e)
(setq a 4)
(setq a 3)
) ;if
;; 6 is the min. number when it makes sense to run this program
(if (< n 6)
(progn
(alert "The POLYLINE is too short!")
(exit)
) ;progn
) ;if
(repeat (- n a)
(setq p-0 (vlax-curve-getpointatparam e (- i 1)))
(setq p-1 (vlax-curve-getpointatparam e (- i 2)))
(setq p-2 (vlax-curve-getpointatparam e (- i 3)))
(setq p-3 (vlax-curve-getpointatparam e (- i 4)))
(setq bulge-0 (vla-getbulge (vlax-ename->vla-object e) (- i 1)))
(setq bulge-1 (vla-getbulge (vlax-ename->vla-object e) (- i 2)))
(setq bulge-2 (vla-getbulge (vlax-ename->vla-object e) (- i 3)))
(setq bulge-3 (vla-getbulge (vlax-ename->vla-object e) (- i 4)))
(if (and (= bulge-3 0) (= bulge-2 0) (= bulge-1 0))
(progn
(setq angle_1 (- 180 (RtD (LM:GetInsideAngle p-1 p-2 p-3))))
(setq angle_2 (- 180 (RtD (LM:GetInsideAngle p-0 p-1 p-2))))
(if (and (> angle_1 min_angle)
(> angle_2 min_angle)
(< angle_1 max_angle)
(< angle_2 max_angle)
(< (distance p-3 p-2) max_length)
(< (distance p-2 p-1) max_length)
)
(progn
(setq bulge (LM:3p->bulge p-3 p-2 p-1))
(vtx-del e p-2)
(setq i (- i 1))
(vla-setbulge (vlax-ename->vla-object e) (- i 3) bulge)
(change_width e p-3 w)
)
;; progn
)
;; if
) ; progn
) ; if
(setq i (+ i 1))
) ;repeat
(setq n1 (+ (fix (vlax-curve-getEndParam e)) 1))
(princ (strcat "\nNumber of segments in the POLYLINE: " (itoa n)))
(terpri)
(princ (strcat "\nNumber of segments in the modified POLYLINE: " (itoa n1)))
(princ)
) ;defun
----------------------------------------
----------------------------------------
;;; SUB programs
----------------------------------------
----------------------------------------
;; Get Inside Angle - Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2
(defun LM:GetInsideAngle (p1 p2 p3)
((lambda (a) (min a (- (+ pi pi) a)))
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
)
-----------------------------
;; converts radians to degrees
(defun RtD (r) (* 180.0 (/ r pi)))
;; converts degrees to radians
(defun DtR (d) (* pi (/ d 180.0)))
-----------------------------
;;; This rutine delets one vertex from the LWPOLYLINE
(defun vtx-del (ent pt / bulges coords idx param)
(vl-load-com)
(defun removenth (n lst / i rtn)
(reverse
(progn
(setq i -1)
(foreach x lst
(if (/= n (setq i (1+ i)))
(setq rtn (cons x rtn))
)
)
rtn
)
)
)
(setq ent (vlax-ename->vla-object ent))
(setq param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0)))
(setq coords (vlax-get ent 'coordinates)
idx -1
bulges nil
)
(repeat (/ (length coords) 2)
(setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges))
)
(setq bulges (removenth param (reverse bulges)))
(repeat 2
(setq coords (removenth (* 2 param) coords))
)
(vlax-put ent 'coordinates coords)
(setq idx -1)
(foreach bulge bulges
(vla-setbulge ent (setq idx (1+ idx)) bulge)
)
(princ)
) ; defun
-----------------------------
;; 3-Points to Bulge - Lee Mac
(defun LM:3p->bulge (p1 p2 p3)
((lambda (a) (/ (sin a) (cos a)))
(/ (+ (- pi (angle p2 p1)) (angle p2 p3)) 2)
)
)
-----------------------------
-----------------------------
;;; Change the width of a given segment in the polyline - Ákos Erdélyi
;;; poly_name - entity name of LWPOLYLINE
;;; point - the begining point of line which has to be make bold
;;; w - width which will set up in polyline
(defun change_width (poly_name point w / number_of_vertex)
(setq number_of_vertex (vlax-curve-getParamAtPoint e point))
(vla-setwidth
(vlax-ename->vla-object e)
number_of_vertex
w
w
)
) ;defun
-----------------------------
;;; PLDIET.lsp [command name: PLD]
;;; To put lightweight PolyLines on a DIET (remove excess vertices); usually
;;; used for contours with too many too-closely-spaced vertices.
;;; Concept from PVD routine [posted on AutoCAD Customization Discussion
;;; Group by oompa_l, July 2009] by Brian Hailey, added to by CAB, and
;;; WEED and WEED2 routines by Skyler Mills at Cadalyst CAD Tips [older
;;; routines for "heavy" Polylines that won't work on newer lightweight ones];
;;; simplified in entity data list processing, and enhanced in other ways [error
;;; handling, default values, join collinear segments beyond max. distance,
;;; limit to current space/tab, account for change in direction across 0 degrees,
;;; option to keep or eliminate arc segments] by Kent Cooper, August 2009.
;;; Last edited 28 August 2013
;;; input variables
;;; disttemp - Maximum distance between non-collinear vertices to straighten
;;; cidtemp - Maximum change in direction to straighten
;;; plsel - selection set, only LWPOLYLINE !
;;; arctemp - Retain or Straighten arc segments [R/S]
(defun RDI:PLD
(disttemp cidtemp arctemp plsel / *error* cmde disttemp cidtemp arctemp plinc plsel pl
pldata ucschanged front 10to42 vinc verts vert1 vert2 vert3)
;
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(if ucschanged (command "_.ucs" "_prev"))
; ^ i.e. don't go back unless routine reached UCS change but didn't change back
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
); end defun - *error*
;
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setq plinc 0)
;;; (setq
;;; disttemp
;;; (getdist
;;; (strcat
;;; "\nMaximum distance between non-collinear vertices to straighten"
;;; (if *distmax* (strcat " <" (rtos *distmax* 2 2) ">") ""); default only if not first use
;;; ": "
;;; ); end strcat
;;; ); end getdist & disttemp
;;;
;;; *distmax*
;;; (cond
;;; (disttemp); user entered number or picked distance
;;; (*distmax*); otherwise, user hit Enter - keep value
;;; ); end cond & *distmax*
;;;
;;; cidtemp
;;; (getangle
;;; (strcat
;;; "\nMaximum change in direction to straighten"
;;; (strcat ; offer prior choice if not first use; otherwise 15 degrees
;;; " <"
;;; (if *cidmax* (angtos *cidmax*) (angtos (/ pi 12)))
;;; ">"
;;; ); end strcat
;;; ": "
;;; ); end strcat
;;; ); end getdist & cidtemp
;;;
;;; *cidmax*
;;; (cond
;;; (cidtemp); user entered number or picked angle
;;; (*cidmax*); Enter with prior value set - use that
;;; ((/ pi 12)); otherwise [Enter on first use] - 15 degrees
;;; ); end cond & *cidmax*
;;;
;;; plinc 0 ; incrementer through selection set of Polylines
;;; ); end setq
;;; (initget "Retain Straighten")
;;; (setq
;;; arctemp
;;; (getkword
;;; (strcat
;;; "\nRetain or Straighten arc segments [R/S] <"
;;; (if *arcstr* (substr *arcstr* 1 1) "S"); at first use, S default; otherwise, prior choice
;;; ">: "
;;; ); end strcat
;;; ); end getkword
;;;
;;; *arcstr*
;;; (cond
;;; (arctemp); if User typed something, use it
;;; (*arcstr*); if Enter and there's a prior choice, keep that
;;; ("Straighten"); otherwise [Enter on first use], Straighten
;;; ); end cond & *arcstr*
;;; ); end setq
;
;;; (prompt "\nSelect LWPolylines to put on a diet, or press Enter to select all: ")
;;; (cond
;;; ((setq plsel (ssget '((0 . "LWPOLYLINE"))))); user-selected Polylines
;;; ((setq plsel (ssget "X" (list '(0 . "LWPOLYLINE") (cons 410 (getvar 'ctab))))))
;;; ; all Polylines [in current space/tab only]
;;; ); end cond
;
(repeat (sslength plsel)
(setq pl (ssname plsel plinc))
(while
(equal (vlax-curve-getStartPoint pl) (vlax-curve-getPointAtParam pl 1) 1e-6)
; to correct for possibility that more than one vertices at beginning coincide,
; in which case Pline does not define a CS under UCS OBject, causing error
(command "_.pedit" pl "_edit" "_straighten" "" "" "_go" "_exit" "")
); while
(setq pldata (entget pl))
(if (/= (cdr (last pldata)) (trans '(0 0 1) 1 0)); extr. direction not parallel current CS
; for correct angle & distance calculations [projected onto current construction
; plane], since 10-code entries for LWPolylines are only 2D points:
(progn
(command "_.ucs" "_new" "_object" pl) ; set UCS to match object
(setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't
); end progn
); end if
(setq
front ; list of "front end" [pre-vertices] entries, minus entity names & handle
(vl-remove-if
'(lambda (x)
(member (car x) '(-1 330 5 10 40 41 42 210))
); end lambda
pldata
); end removal & front
10to42 ; list of all code 10, 40, 41, 42 entries only
(vl-remove-if-not
'(lambda (x)
(member (car x) '(10 40 41 42))
); end lambda
pldata
); end removal & 10to42
vinc (/ (length 10to42) 4); incrementer for vertices within each Polyline
verts nil ; eliminate from previous Polyline [if any]
); end setq
(if (= *arcstr* "Straighten")
(progn
(setq bulges ; find any bulge factors
(vl-remove-if-not
'(lambda (x)
(and
(= (car x) 42)
(/= (cdr x) 0.0)
); end and
); end lambda
10to42
); end removal & bulges
); end setq
(foreach x bulges (setq 10to42 (subst '(42 . 0.0) x 10to42)))
; straighten all arc segments to line segments
); end progn
); end if
(repeat vinc
(setq
verts ; sub-group list: separate list of four entries for each vertex
(cons
(list
(nth (- (* vinc 4) 4) 10to42)
(nth (- (* vinc 4) 3) 10to42)
(nth (- (* vinc 4) 2) 10to42)
(nth (1- (* vinc 4)) 10to42)
); end list
verts
); end cons & verts
vinc (1- vinc) ; will be 0 at end
); end setq
); end repeat
(while (nth (+ vinc 2) verts); still at least 2 more vertices
(if
(or ; only possible if chose to Retain arc segments
(/= (cdr (assoc 42 (nth vinc verts))) 0.0); next segment is arc
(/= (cdr (assoc 42 (nth (1+ vinc) verts))) 0.0); following segment is arc
); end or
(setq vinc (1+ vinc)); then - don't straighten from here; move to next
(progn ; else - analyze from current vertex
(setq
vert1 (cdar (nth vinc verts)) ; point-list location of current vertex
vert2 (cdar (nth (1+ vinc) verts)); of next one
vert3 (cdar (nth (+ vinc 2) verts)); of one after that
ang1 (angle vert1 vert2)
ang2 (angle vert2 vert3)
); end setq
(if
(or
(equal ang1 ang2 0.0001); collinear, ignoring distance
(and
(<= (distance vert1 vert3) *distmax*)
; straightens if direct distance from current vertex to two vertices later is
; less than or equal to maximum; if preferred to compare distance along
; Polyline through intermediate vertex, replace above line with this:
; (<= (+ (distance vert1 vert2) (distance vert2 vert3)) *distmax*)
(<=
(if (> (abs (- ang1 ang2)) pi); if difference > 180 degrees
(+ (min ang1 ang2) (- (* pi 2) (max ang1 ang2)))
; then - compensate for change in direction crossing 0 degrees
(abs (- ang1 ang2)); else - size of difference
); end if
*cidmax*
); end <=
); end and
); end or
(setq verts (vl-remove (nth (1+ vinc) verts) verts))
; then - remove next vertext, stay at current vertex for next comparison
(setq vinc (1+ vinc)); else - leave next vertex, move to it as new base
); end if - distance & change in direction analysis
); end progn - line segments
); end if - arc segment check
); end while - working through vertices
(setq
front (subst (cons 90 (length verts)) (assoc 90 front) front)
; update quantity of vertices for front end
10to42 nil ; clear original set
); end setq
(foreach x verts (setq 10to42 (append 10to42 x)))
; un-group four-list vertex sub-lists back to one list of all 10, 40, 41, 42 entries
(setq pldata (append front 10to42 (list (last pldata))))
; put front end, vertex entries and extrusion direction back together
(entmake pldata)
(entdel pl); remove original
(setq plinc (1+ plinc)); go on to next Polyline
(if ucschanged
(progn
(command "_.ucs" "_prev")
(setq ucschanged nil) ; eliminate UCS reset in *error* since routine did it already
); end progn
); end if - UCS reset
); end repeat - stepping through set of Polylines
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); end defun - PLD
(prompt "\nType PLD to put PolyLines on a Diet.")
-----------------------------
![Autodesk Design & Make Report](https://forums.autodesk.com/t5/image/serverpage/image-id/1350519iCB55845EBFC43016/image-size/large?v=v2&px=999" "Autodesk Design & Make Report")
