Please have a try.

Regards.

CODE:

`;| PLDIET.lsp [command name: PLD]To put lightweight PolyLine(s) on a DIET (remove excess vertices); usually used for contour lines with more too-closely-spaced vertices than necessary, but applicable for other purposes, such as to simplify a many-sided polygon to fewer sides.Asks User for max. distance between non-collinear vertices, and max. change in direction, to straighten [i.e. remove vertices between], and whether to straighten arc segments to line segments. No initial default max. length-to-straighten value on first use; initial default max. bend-to-straighten: 15 degrees; initial default for arc segments: Straighten. Remembers choices; offers as defaults on subsequent use. [Search for ;; EDIT below to find locations to change first-use defaults.]Removes all intermediate vertices through collinear stretches, regardless of max. length-to-straighten setting.Note that removal of vertex at bend changes angle of combined segment, which changes comparison of change-in-direction to next segment. Example: In regular dodecagon, change in direction between segments is 30 degrees, so setting at least that large will remove vertices. When given vertex is removed, next change-in- direction comparison will be between new, longer, straightened segment and next shorter original one, which will now be 45 degrees. If intent is to keep every third vertex [change dodecagon to square], in order to remove that next vertex, change in direction setting must allow for 45 degrees, not just 30 degrees of original shape's changes in direction.Concept from PVD routine by Brian Hailey [posted on AutoCAD Customization Forum by oompa_l, July 2009], added to by CAB, and WEED and WEED2 routines by Skyler Mills at Cadalyst CAD Tips [older routines for "heavy" Polylines that don'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, forbid locked Layers].Variable names surrounded by :colons: and beginning with :PLD are global for subsequent defaults.[Note: Written for new-enough versions that LWPolyline entity data contains (91 . ...) entry for each vertex. As of Acad 2019, those are always (91 . 0), but if usage changes in future version and they can differ, may need to adjust this routine. Also for new- enough versions to have (command-s) function, for UCS reset in *error*.]Kent Cooper, last edited 30 October 2019|;(defun C:PLD ; = PolyLine Diet (/ *error* modPL doc svn svv pldss n pl pldata front 10to91 vinc closed verts bulges ucsch v1 v2 v3 ang1 ang2) (setq maxVertices 400) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); if (if ucsch (command-s "_.ucs" "_previous")) ; i.e. don't go back unless routine reached UCS change but didn't change back (mapcar 'setvar svn svv) (vla-endundomark doc) ); defun -- *error* (defun modPL () (setq front (subst (cons 90 (length verts)) (assoc 90 front) front) ; update quantity of vertices for front end 10to91 nil ; clear original set ); setq (foreach x verts (setq 10to91 (append 10to91 x))) ; un-group five-list vertex sub-lists back to one list of all 10, 40, 41, 42, 91 entries (setq pldata (append front 10to91 (list (last pldata)))) ; put front end, vertex entries and extrusion direction back together (entmod pldata) ); defun -- modPL (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq svn '(cmdecho ucsfollow); = System Variable Names svv (mapcar 'getvar svn); = System Variable Values ); setq (mapcar 'setvar svn '(0 0)); turn off command echoing, UCS following (initget (if :PLDdist: 6 7)); no zero, no negative, no Enter on first use (setq :PLDdist: (cond ( (getdist (strcat "\nMaximum distance between non-collinear vertices to straighten" (if :PLDdist: (strcat " <" (rtos :PLDdist:) ">") ""); default after first use ": " ); strcat ); getdist ); User-input condition (:PLDdist:); on Enter [when permitted] -- keep prior value ); cond & :PLDdist: ); setq (initget 6); no zero, no negative (setq :PLDcid: (cond ( (getangle (strcat "\nMaximum change in direction to straighten <" (angtos (cond (:PLDcid:) ((/ pi 12)))) ;; EDIT for different initial default ; prior choice if present; otherwise 15 degrees ">: " ); strcat ); getangle ); User-input condition (:PLDcid:); on Enter with prior value -- keep it ((/ pi 12)); otherwise [Enter on first use] -- 15 degrees ;; EDIT for different initial default ); cond & :PLDcid: ); setq (initget "Retain Straighten") (setq :PLDarc: (cond ( (getkword (strcat "\nRetain or Straighten arc segments [Retain/Straighten] <" (if :PLDarc: (substr :PLDarc: 1 1) "S"); prior default if present, otherwise S ;; EDIT for different initial default ["R"] ">: " ); strcat ); getkword ); User-input condition (:PLDarc:); on Enter with prior choice -- keep that ("Straighten"); Enter on first use ;; EDIT for different initial default ["Retain"] ); cond & :PLDarc: ); setq (prompt "\nTo put LWPolyline(s) on a diet {All option available},") (if (setq pldss (ssget (list (cons 0 "LWPOLYLINE") ))) (progn ; then (repeat (setq n (sslength pldss))(setq ent (ssname pldss (setq n (1- n))) plLst (BreakPline ent maxVertices)); break to plines with smaller vertices(setq ss (ssadd ))(foreach pl plLst (setq pldata (entget pl) front ; list of "front end" [other-than-vertex] entries, also minus extr. dir. (vl-remove-if '(lambda (x) (member (car x) '(10 40 41 42 91 210)) ); lambda pldata ); remove & front 10to91 ; list of all code 10, 40, 41, 42, 91 entries only (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42 91))) pldata) vinc (/ (length 10to91) 5); incrementer for vertices within each Polyline ; closed (vlax-curve-isClosed pl) closed (= 1 (cdr (assoc 70 pldata)) ) verts nil ; eliminate from previous Polyline [if any] ); setq (if (= :PLDarc: "Straighten") (progn (setq bulges ; find any non-zero bulge factors [= arc segments] (vl-remove-if-not '(lambda (x) (and (= (car x) 42) (/= (cdr x) 0.0) ); and ); lambda 10to91 ); removal & bulges ); setq (foreach x bulges (setq 10to91 (subst '(42 . 0.0) x 10to91))) ; straighten all arc segments to line segments ); progn ); if (repeat vinc (setq verts ; sub-group list: separate lists of five entries for each vertex (cons (list (nth (- (* vinc 5) 5) 10to91); 10 (nth (- (* vinc 5) 4) 10to91); 40 (nth (- (* vinc 5) 3) 10to91); 41 (nth (- (* vinc 5) 2) 10to91); 42 (nth (1- (* vinc 5)) 10to91); 91 ); listverts); cons & verts vinc (1- vinc) ; will be 0 at end ); setq ); repeat (while (equal (caar verts) (caadr verts) 1e-6) (setq verts (cdr verts))) ; eliminate possible coincident vertices at beginning, which would ; mean Pline does not define a CS under UCS OBject, causing error (modPL); to re-establish pldata (if (/= (cdr (assoc 210 pldata)) (trans '(0 0 1) 1 0)); extr. dir. 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 ucsch T) ; marker for *error* to reset UCS if routine doesn't ); progn ); if (while (nth (+ vinc (if closed 1 2)) verts) (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); or (setq vinc (1+ vinc)); then -- don't straighten from here; move to next (progn ; else -- analyze from current vertex(setq v1 (cdar (nth vinc verts)) ; point-list location of current vertex v2 (cdar (nth (1+ vinc) verts)); of next one v3 (cdar (nth (if (and closed (= (+ vinc 2) (length verts))) 0 (+ vinc 2)) verts)) ; of second one after current, or of start if closed and at end ang1 (angle v1 v2) ang2 (angle v2 v3) ); setq(if (or (equal ang1 ang2 1e-4); collinear [ignoring distance] (and (<= (distance v1 v3) :PLDdist:) ; EDIT if desired: ; straightens if direct distance from current vertex to two vertices later, ; ignoring any bend, is less than or equal to maximum; if preferred to ; compare distance along Polyline through intermediate vertex, ; replace above line with this: ; (<= (+ (distance v1 v2) (distance v2 v3)) :PLDdist:) (<=(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 ); if:PLDcid:); <= ); and ); or (setq verts (vl-remove (nth (1+ vinc) verts) verts)) ; then -- remove next vertex, stay at current vertex for next comparison (setq vinc (1+ vinc)); else -- leave next vertex, move to it as new base ); if -- distance & change in direction analysis); progn -- line segments ); if -- arc segment check ); while -- working through vertices (modPL) (if ucsch (progn (command "_.ucs" "_previous") (setq ucsch nil); eliminate UCS reset in *error* since routine did it already ); progn ); if -- UCS reset (ssadd pl ss) ); join to Polyline(if(> (sslength ss) 1) (command "Pedit" "m" ss "" "J" "" "X" ""))); repeat -- step through set of Polylines (princ "\nDone.") ); progn [then -- selection] (prompt "\nNo Polyline(s) selected."); else ); if (mapcar 'setvar svn svv) (vla-endundomark doc) (princ)); defun -- C:PLD(defun CoordinatesOfPline ( ent / edata pt) (setq edata (entget ent)) (setq lst (list)) (foreach it edata (if (= (car it) 10 ) (setq lst (cons (cdr it) lst)) ) ) (reverse lst) )(defun GetLastEnt ( / ename result ) (if (setq result (entlast)) (while (setq ename (entnext result)) (setq result ename) ) ) result )(defun BreakPline(ent maxVertices / pt) (setq coors (CoordinatesOfPline ent)) (setq res (list ent)) (if (> (length coors) (* 2 maxVertices)) (progn (setq breakPtLst (list) i maxVertices) (while (< i (-(length coors) (* maxVertices 0.2)))(setq breakPtLst (cons (nth i coors) breakPtLst) i (+ i maxVertices)) ) (setq lastEnt (GetLastEnt)) (foreach pt breakPtLst(command "break" ent "_non" (trans pt 0 1) "_non" (trans pt 0 1))(if (not (equal LastEnt (entlast))) (setq lastEnt (entlast)res (cons lastEnt res)) )) ) ) res )(vl-load-com)(prompt "\nType PLD to put PolyLine(s) on a Diet.")`

Statistics: Posted by QuanNguyen — Tue Nov 12, 2019 3:27 am

]]>

Alternatively, you can also use

Statistics: Posted by CMS Inc — Mon Nov 11, 2019 10:38 am

]]>

CODE:

`;;; 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.;(defun C:PLD (/ *error* cmde disttemp cidtemp arctemp plinc plsel pldata ucschanged front 10to42 vinc verts vert1 vert2 vert3); (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort")) (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 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 (T *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 (T (/ 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 (T "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 pldata (entget (ssname plsel plinc))) (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" (ssname plsel plinc)) ; 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 (ssname plsel plinc)); 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.")`

Statistics: Posted by Vik12 — Wed Nov 06, 2019 11:48 pm

]]>

CODE:

`;;; 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.;(defun C:PLD (/ *error* cmde disttemp cidtemp arctemp plinc plsel pldata ucschanged front 10to42 vinc verts vert1 vert2 vert3); (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort")) (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 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 (T *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 (T (/ 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 (T "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 pldata (entget (ssname plsel plinc))) (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" (ssname plsel plinc)) ; 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 (ssname plsel plinc)); 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.")`

Statistics: Posted by Vik12 — Wed Nov 06, 2019 11:44 pm

]]>

;; (load "hpglout")(C:hpglout)

; Cycle through the drawing & save details of lines,Arcs & Circles to a HPGL format file

; Program works on a per layer baises

; Cirles still seem iffy

;; For those times when you dont have a driver or are dealing with legacy hardware

;; You may then need to send the file direct to the serial port, which will look something like these DOS commands:

;; MODE COM1 BAUD=9600 PARITY=n DATA=8

;; COPY yourfile.hpg COM1

; Tim Gathercole - 19 Oct 2019

;; GLOBALS: dScale term f5

(defun C:hpglout ( / dwgnm ss_drw) ; ll ur

(setq fln (getvar "dwgname"))

(setq hpfl (substr fln 1 (- (strlen fln) 4) ) ) ;

(setq FnPath "C:\\files\\") ; dir to save file into

(setq spno "SP7")

(setq dScale 40)

(setq term ";")

(setq f5 (open (strcat FnPath hpfl ".hpg") "w"))

(setq ll (getvar "EXTMIN")

ur (getvar "EXTMAX") ) ; Many hardware systems require a 0,0 start point. It's simplest to move bottom Left to 0,0 if necessary. Just add a move after this code.

(writeData "CREASE")

(writeData "CUT") ; No error checking yet - so there better be something on the layer

; Tail end of the HPGL file

(write-line (strcat "SP0" term) f5) ; END / Put the pen away

(close f5)

); C:hpglout

; <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

(defun writeData (laynam / ss tl n ent itm obj q xs ys xe ye)

; Save drawing details to HPGL file

(princ "\n laynam = ") (princ laynam);Erase_DV

(if (= laynam "CUT")

(setq spno "SP5") ; Cut Knife - Tool numbers will vary

(setq spno "SP7") ; ELSE Crease Wheel

) ; if

(write-line (strcat spno term) f5)

(setq ss (ssget "_X" (list (cons 8 laynam)))) ; Get all Entities

(if (null ss)

(princ "\nNo Entitys found on Layer.\n")

(progn ; ELSE

(setq n (1- (sslength ss)))

(while (>= n 0)

(setq ent (entget (setq itm (ssname ss n)))

obj (cdr (assoc 0 ent))

q (cond

((= obj "LINE") (progn

(write-line (strcat "PU" (rtos (* (cadr (assoc 10 ent)) dScale) 2 4) "," (rtos (* (caddr (assoc 10 ent)) dScale) 2 4) term) f5) ; Move to Start

(write-line (strcat "PD" (rtos (* (cadr (assoc 11 ent)) dScale) 2 4) "," (rtos (* (caddr (assoc 11 ent)) dScale) 2 4) term) f5) ; Draw to End

)) ; LINE

((= obj "ARC")

(arcout ent)

) ; ARC

((= obj "CIRCLE")

; PA uses Center / CI Radius (includes PD command)

(write-line (strcat "PU" (rtos (* (cadr (assoc 10 ent)) dScale) 2 4) "," (rtos (* (caddr (assoc 10 ent)) dScale) 2 4) term) f5) ; Move to Start / Center

(write-line (strcat "CI" (rtos (* (/ (car (assoc 40 ent)) 4) dScale) 2 4) term) f5) ; Still wondering why its /4 not 2

) ; OTHER

) ; cond

n (1- n)))

));progn IF

); writeData

; <><><><><><><><><><><><><><><><><><><><><>

; GLOBAL dScale term

(defun arcout (ent / aendx aendy Ang aStrX aStrY cen CenX CenY sAng eAng rad)

(setq cen (cdr (assoc 10 ent)) ; Centre XYZ

rad (cdr (assoc 40 ent)) ; Radius

sAng (cdr (assoc 50 ent))

eAng (cdr (assoc 51 ent))

); Start angle

(setq aStrX (* (+ (* rad (cos sAng)) (car cen)) dScale)

aStrY (* (+ (* rad (sin sAng)) (cadr cen)) dScale)

aEndX (* (+ (* rad (cos eAng)) (car cen)) dScale)

aEndY (* (+ (* rad (sin eAng)) (cadr cen)) dScale)

CenX (* (car cen) dScale)

CenY (* (cadr cen) dScale) ) ; end points not necessary but you never know when a version will need them

(if (> sAng eAng)

(progn

(setq eAng (+ eAng 360))

(setq Ang (dtr (- eAng (Rad2Deg sAng)) ) ) ; progs like Radians but HPGL & Humans like degrees

) ; else

(progn

(setq Ang (- eAng sAng) )

) )

(write-line (strcat "PU" (rtos aStrX 2 4) "," (rtos aStrY 2 4) term) f5) ; Move to Start / Center

(write-line (strcat "PDAA" (rtos CenX 2 4) "," (rtos CenY 2 4) "," (rtos (Rad2Deg Ang) 2 4) term) f5) ; Control points and end

) ; arcout

; <><><><><><><><><><><><><><><><><><><><><>

; <><><><><><><><><><><><><><><><><><><><><>

; Convert Degrees to Radians

(defun dtr (x)

;define degrees to radians function

(* pi (/ x 180.0))

;divide the angle by 180 then

;multiply the result by the constant PI

);end of function

; <><><><><><><><><><><><><><><><><><><><><>

; Convert Degrees to Radians

(DEFUN Rad2Deg (a / ret)

(setq a (read (rtos a 2 5)) ; 5 decimal places

ret (* a 57.2957795147))

ret ; returned value

) ; defun

; <><><><><><><><><><><><><><><><><><><><><>

Statistics: Posted by timg — Sat Oct 19, 2019 8:25 am

]]>

Set it to 1 at the CMS IntelliCAD command bar and the Lisp script should work.

Statistics: Posted by CMS Inc — Tue Oct 15, 2019 9:51 am

]]>

Statistics: Posted by EngnrRuss — Tue Aug 06, 2019 10:52 am

]]>

Yes I asked a question 2 years ago, that no one stepped up to the plate to offer help.

But thanks again for your continued constructive help.

It is help from............................................never mind.

Statistics: Posted by sln8458 — Wed May 22, 2019 8:59 am

]]>

So let me get this straight ....AFTER TWO YEARS ... two years ...

SIN8458

you replied again ...

but with no answer to the question you asked TWO FN YEARS ago ....

if you still do not have the answer ...then get out of the business

roflmao

Statistics: Posted by UberEber — Sat May 18, 2019 8:19 pm

]]>

Statistics: Posted by Danielm103 — Mon May 06, 2019 7:00 pm

]]>

]]>

(if

(= myString newInput)

(princ "myString has been set to newInput) ;do if true

(progn ;do if false

(princ "Have a great morning. \n")

(princ "Have a great afternoon - too. \n")

);end progn

); end if

the above can fail.

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

Use PROGN ...twice

although technically according to LISP syntax you do not have to.

(if

(= myString newInput)

(progn ;**** NEW PROGN not really needed *****

(princ "myString has been set to newInput) ;do if true

);end progn

(progn ;do if false

(princ "Have a great morning. \n")

(princ "Have a great afternoon - too. \n")

);end progn

); end if

Summary: Use two progn's in an IF statement - avoid just one.

Have a day!

Statistics: Posted by UberEber — Sun May 05, 2019 7:27 am

]]>

;explode etc

(command "-xplode" "last" "" "LA" Layer-Name ) ;Xplode the entity onto the layer revealing xData

(terpri)

(princ)

(command)

(princ "");Sad but it does not do this quietly...

and all combinations

it just will not shut up ...

Apparently still not fixed.

Statistics: Posted by UberEber — Sat May 04, 2019 7:01 am

]]>

What are you trying to load?

What are you trying to do?

There is always a work around.

Please be more specific.

Statistics: Posted by UberEber — Sat May 04, 2019 6:54 am

]]>

[sniff]

Q: ALEXA PLEASE TRANSLATE --->

"I asked him if there was a possibility of a version of DOSLib for 64-bit IntelliCAD, and he said no - too much work for a free tool."

A: Very useful old library for 32 bit single core processors. Will be around for years.

Q: ALEXA PLEASE ...predict future of DOSlib

A: It has gone open source as few want to support it with current new technology. RIP DosLib

Statistics: Posted by UberEber — Sat Apr 27, 2019 5:26 am

]]>