Tamim Posted October 28 Posted October 28 HI, I’m working on a CAD drawing that has several parallel polylines, and I’d like to space them out evenly by a fixed distance, but only from their start points. For example, all the lines begin from point No. 1, and I want to distribute only between line 1 and line 2, keeping the rest aligned. The goal is to spread them equally on the opposite side, similar to how the “Distribute” option works in TEXTALIGN, but for polylines instead of text. It would be great if the spacing value (for example, 0.2 ft or 0.5 ft) could be entered by the user. Does anyone know if there’s an existing LISP routine for this, or something close? Any tips or examples would be really helpful. line shifting.dwg Quote
Saxlle Posted October 29 Posted October 29 Hi @Tamim Try this code and see if it fulfil your needs: ; ******************************************************** ; Functions : ESP (Evenly Spacing the Polylines) ; Description : Evenly Spacing Polylines ; Author : SAXLLE ; Date : October 29, 2025 ; ******************************************************** (prompt "\nTo run a LISP type: ESP (Evenly Spacing the Polylines)") (princ) (defun c:ESP ( / myerr olderr old_osmode flag ss len lst i spacing side base_point inc ent dist_lst npt answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (prompt "\nSelect Polylines:") (princ) (setq ss (ssget (list (cons 0 "*POLYLINE"))) len (sslength ss) lst (list) i 0 ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length")) lst) i (1+ i) ) ) (initget 1 "Left Right") (setq lst (vl-sort lst (function (lambda (a b) (< (cadr a) (cadr b))))) side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length lst)) (setq ent (car (nth i lst)) dist_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth i lst)))))) (cdr pt_list))) ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<180") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<0") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) ) (entdel (car (nth i lst))) (setq inc (+ inc spacing) i (1+ i) ) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (prompt "\The polylines are evenly spaced!") (princ) ) Also, you can see the short video of how does lisp are working. EvenlySpacingPolyline.mp4 Best regards. Quote
BIGAL Posted October 29 Posted October 29 Hi @Saxlle started to do something found the plines are drawn in a CCW or CW direction for left right so I am going to set that to one direction I look at the length of 1st and 3rd section to work out which end to change, so no need for Left or right. The start point is (/ offset 2) left or right. So don't need user enter base_point. I just worked out the new X values for the pline and use (vlax-put obj 'coordinates pts) to redo the pline no need to actually draw a new pline. use (vlax-get obj 'coordinates) for the XY values of the pline. Yes need a ssget but looking at a drag over the plines for offset order. So yes would do twice for sample. NOTE my code is based on the sample dwg provided, got about 1/2 way when posting this, hopefully later today will post my attempt. Quote
Tamim Posted October 30 Author Posted October 30 14 hours ago, Saxlle said: Hi @Tamim Try this code and see if it fulfil your needs: ; ******************************************************** ; Functions : ESP (Evenly Spacing the Polylines) ; Description : Evenly Spacing Polylines ; Author : SAXLLE ; Date : October 29, 2025 ; ******************************************************** (prompt "\nTo run a LISP type: ESP (Evenly Spacing the Polylines)") (princ) (defun c:ESP ( / myerr olderr old_osmode flag ss len lst i spacing side base_point inc ent dist_lst npt answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (prompt "\nSelect Polylines:") (princ) (setq ss (ssget (list (cons 0 "*POLYLINE"))) len (sslength ss) lst (list) i 0 ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length")) lst) i (1+ i) ) ) (initget 1 "Left Right") (setq lst (vl-sort lst (function (lambda (a b) (< (cadr a) (cadr b))))) side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length lst)) (setq ent (car (nth i lst)) dist_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth i lst)))))) (cdr pt_list))) ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<180") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<0") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) ) (entdel (car (nth i lst))) (setq inc (+ inc spacing) i (1+ i) ) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (prompt "\The polylines are evenly spaced!") (princ) ) Also, you can see the short video of how does lisp are working. EvenlySpacingPolyline.mp4 714.6 kB · 0 downloads Best regards. @Saxlle Thanks for the code. It’s working based on the concept. Please check the DWG file. I’ve worked on Option 1 and Option 2. In Option 1, I planned the left-side spacing as per your video input, all settings are done, but the output line looks different. Please advise on this. Option 2 is another concept where the top side moves up and down, similar to the left and right adjustments line shifting.dwg Quote
Saxlle Posted October 30 Posted October 30 Hey @BIGAL, I used a "base point" to avoid determinanting is the polyline drawn CCW or CW, easier, and then calculated new position of the polylines based on choosing "Left or Right", which means the "X" coord will change in that side. Also, I supose that the polyline can have many vertexes and drawed randomly (not only straight lines). Bassicly, this is the one of the concept how it can be done. 8 hours ago, BIGAL said: Yes need a ssget but looking at a drag over the plines for offset order I figured out the easiest way is sorting by the Lengths of the polyline, from min to max, to get a proper order. 8 hours ago, BIGAL said: NOTE my code is based on the sample dwg provided, got about 1/2 way when posting this, hopefully later today will post my attempt. Can't wait to see your solution, maybe find something interesting inside the code . Quote
Saxlle Posted October 30 Posted October 30 Hey @Tamim, Glad it works for the "based concept". But, I can't figure out "Option 1" and "Option 2", it's really messy to understand what I need to accomplish (because there is a bunch of overlapping polylines).If you can provide a clear, detailed, explanation, I will try to fix the code so that it works for "Y" direction movements as well. Best regards. Quote
BIGAL Posted Thursday at 09:42 PM Posted Thursday at 09:42 PM (edited) "so that it works for "Y" direction movements as well." I did think about what happens if the objects are drawn on an angle, There may be a way by using work out the new points using a 90 angle off the existing points. Suddenly busy so not sure when will have time to do something. Edited Thursday at 09:43 PM by BIGAL Quote
BIGAL Posted Sunday at 10:53 PM Posted Sunday at 10:53 PM Another version just drag over the plines left and right. https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw (ent / area1 area2 dist lst obj objnew pointmax pointmin) (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put obj 'coordinates lst) ) ) (setvar 'osmode oldsnap) (princ) ) (c:wow) 1 Quote
Saxlle Posted Monday at 02:48 PM Posted Monday at 02:48 PM (edited) Nice @BIGAL . If you don't mind, I added a few lines of code to yours to make it work properly. ; https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw ( ent / area1 area2 dist obj objnew pointmax pointmin) ;; remove "lst" from local variables (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) lst ;; added this line to get a list of coordinates as "output" (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put (vlax-ename->vla-object plent) 'coordinates lst) ;; added here "(vlax-ename->vla-object plent)" instend of "obj" ) ) (setq lst nil) ;; added this line of code to "release" variable "lst" (setvar 'osmode oldsnap) (princ) ) Best regards. Edited Monday at 02:48 PM by Saxlle Quote
BIGAL Posted yesterday at 03:11 AM Posted yesterday at 03:11 AM No worries glad you got it working. Quote
Tamim Posted 12 hours ago Author Posted 12 hours ago On 03/11/2025 at 04:23, BIGAL said: Another version just drag over the plines left and right. https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw (ent / area1 area2 dist lst obj objnew pointmax pointmin) (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put obj 'coordinates lst) ) ) (setvar 'osmode oldsnap) (princ) ) (c:wow) @BIGAL Thanks for the code Quote
Tamim Posted 12 hours ago Author Posted 12 hours ago On 03/11/2025 at 20:18, Saxlle said: Nice @BIGAL . If you don't mind, I added a few lines of code to yours to make it work properly. ; https://www.cadtutor.net/forum/topic/98797-looking-for-a-lisp-to-evenly-space-polylines-from-their-end-points/ ; paralelle lines change ; offset a pline by an amount ; by AlanH Nov 2025 (defun c:wow ( / co-ord len1 len2 lst off off2 pt1 pt2 pts) ; Checking if pline is CW or CCW and set to CCW ; Orignal idea by Kent Cooper, 1 August 2018 Offsetinorout.lsp ; Modified By Alan H July 2020 (defun AH:chkcwccw ( ent / area1 area2 dist obj objnew pointmax pointmin) ;; remove "lst" from local variables (setq obj (vlax-ename->vla-object ent)) (setq lst (vlax-get obj 'coordinates)) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq dist (/ (distance pointmin pointmax) 20.0)) (vla-offset obj dist) (setq objnew (vlax-ename->vla-object (entlast))) (setq area1 (vlax-get objnew 'Area)) (vla-delete objnew) (vla-offset obj (- dist)) (setq objnew (vlax-ename->vla-object (entlast))) (setq area2 (vlax-get objnew 'Area)) (vla-delete objnew) (if (> area1 area2) (progn (command "pedit" ent "R" "") (setq lst (vlax-get obj 'coordinates)) ) ) lst ;; added this line to get a list of coordinates as "output" (princ) ) (defun replace-nth (lst n newVal) (cond ((null lst) nil) ((= n 0) (cons newVal (cdr lst))) (T (cons (car lst) (replace-nth (cdr lst) (1- n) newVal)))) ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off (getreal "\nEnter offset value ")) (while (setq pt1 (getpoint "\nPick 1st point outside ")) (setq pt2 (getpoint pt1 "\nPick 2nd point inward ")) (setq off2 (/ off 2.0)) (setq pts (list pt1 pt2)) (setq ss (ssget "F" pts '((0 . "LWPOLYLINE")))) (repeat (setq x (sslength ss)) (setq plent (ssname ss (setq x (1- x)))) (AH:chkcwccw plent) (setq len1 (distance (list (nth 0 lst)(nth 1 lst)) (list (nth 2 lst)(nth 3 lst)))) (setq len2 (distance (list (nth 4 lst)(nth 5 lst))(list (nth 6 lst)(nth 7 lst)))) (if (> len1 len2) (progn (setq lst (replace-nth lst 0 (+ (nth 0 lst) off2))) (setq lst (replace-nth lst 2 (+ (nth 2 lst) off2))) (setq off2 (+ off2 off)) ) (progn (setq lst (replace-nth lst 6 (- (nth 6 lst) off2))) (setq lst (replace-nth lst 4 (- (nth 4 lst) off2))) (setq off2 (+ off2 off)) ) ) (vlax-put (vlax-ename->vla-object plent) 'coordinates lst) ;; added here "(vlax-ename->vla-object plent)" instend of "obj" ) ) (setq lst nil) ;; added this line of code to "release" variable "lst" (setvar 'osmode oldsnap) (princ) ) Best regards. @Saxlle Based on this code, everything is working fine. But I need only a specific selection — the sample yellow rectangle area I mentioned earlier. Also, I need to add my idea for selecting the REVCLOUD area after the code runs. line shifting v2.dwg Quote
Saxlle Posted 2 hours ago Posted 2 hours ago Hey @Tamim I'v made a new lisp, so you have an ESP1.lsp (for the first option 1) and an ESP2R.lsp (for the last option/option 2) for the REVCLOUD. This is the codes: ; ********************************************************************** ; Functions : ESP1 (Evenly Spacing the Polylines) --> Option 1 ; Description : Evenly Spacing Polylines --> Option 1 ; Author : SAXLLE ; Date : October 29, 2025 ; ********************************************************************** (prompt "\nTo run a LISP type: ESP1 (Evenly Spacing the Polylines 1)") (princ) (defun c:ESP1 ( / myerr olderr old_osmode flag ss len lst i spacing side base_point inc ent dist_lst npt answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (prompt "\nSelect Polylines:") (princ) (setq ss (ssget (list (cons 0 "*POLYLINE"))) len (sslength ss) lst (list) i 0 ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length")) lst) i (1+ i) ) ) (initget 1 "Left Right") (setq lst (vl-sort lst (function (lambda (a b) (< (cadr a) (cadr b))))) side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length lst)) (setq ent (car (nth i lst)) dist_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth i lst)))))) (cdr pt_list))) ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<180") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<0") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) ) (entdel (car (nth i lst))) (setq inc (+ inc spacing) i (1+ i) ) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (prompt "\The polylines are evenly spaced!") (princ) ) ; ********************************************************************************** ; Functions : ESP2R (Evenly Spacing the Polylines 2 REVCLOUD) --> Option 2 ; Description : Evenly Spacing the Polylines 2 REVCLOUD --> Option 2 ; Author : SAXLLE ; Date : November 05, 2025 ; ********************************************************************************** (prompt "\nTo run a LISP type: ESP2R (Evenly Spacing the Polylines 2 REVCLOUD)") (princ) (defun c:ESP2R ( / old_osmode myerr olderr flag rev rev_ptlist ss lst lst_col i len sort_lst n val side spacing base_point inc ent_lst spt dist_lst ang_lst k answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (setq rev (car (entsel "\nSelect the REVCLOUD:"))) (while (equal rev nil) (prompt "\nNothing was selected. Try again...") (setq rev (car (entsel "\nSelect the REVCLOUD:"))) ) (setq rev_ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget rev))) ss (ssget "_F" rev_ptlist (list (cons 0 "*POLYLINE"))) lst (list) lst_col (list) i 0 ) (if (ssmemb rev ss) (progn (ssdel rev ss) (setq len (sslength ss)) ) ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length") (getpropertyvalue (ssname ss i) "Color")) lst) lst_col (cons (getpropertyvalue (ssname ss i) "Color") lst_col) i (1+ i) ) ) ;; sub-function to remove the double elements from the list (defun remove_doubles (lst) (if lst (cons (car lst) (remove_doubles (vl-remove (car lst) lst))) ) ) (setq lst_col (vl-sort (remove_doubles lst_col) (function (lambda (a b) (< (atoi a) (atoi b))))) sort_lst (list) n 0 ) (repeat (length lst_col) (setq val (nth n lst_col) sort_lst (cons (vl-sort (vl-remove-if-not (function (lambda (a) (equal val (cadr (cdr a))))) lst) (function (lambda (a b) (> (cadr a) (cadr b))))) sort_lst) n (1+ n) ) ) (setq sort_lst (cons (vl-remove (car (last sort_lst)) (last sort_lst)) sort_lst) sort_lst (vl-remove (last sort_lst) sort_lst) ) (initget 1 "Left Right") (setq side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length sort_lst)) (setq ent_lst (nth i sort_lst) n 0 ) (repeat (length ent_lst) (setq spt (vlax-curve-getStartPoint (car (nth n ent_lst)))) (if (not (equal (car base_point) (car spt) 5.0)) (progn (command-s "_reverse" (car (nth n ent_lst)) "") ) ) (setq dist_lst (list) ang_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth n ent_lst)))))) (cdr pt_list))) ang_lst (mapcar (function (lambda (x) (angle (car x) (cadr x)))) (mapcar 'list (setq ang_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth n ent_lst)))))) (cdr ang_list))) dist_lst (subst (+ (nth 1 dist_lst) inc) (nth 1 dist_lst) dist_lst) k 0 ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (setvar 'cecolor (caddr (nth n ent_lst))) (command "_pline") (while (= (getvar "CMDNAMES") "PLINE") (command npt) (repeat (length dist_lst) (command (strcat "@" (rtos (nth k dist_lst) 2 2) "<" (angtos (nth k ang_lst)))) (setq k (1+ k)) ) (command "") ) ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (setvar 'cecolor (caddr (nth n ent_lst))) (command "_pline") (while (= (getvar "CMDNAMES") "PLINE") (command npt) (repeat (length dist_lst) (command (strcat "@" (rtos (nth k dist_lst) 2 2) "<" (angtos (nth k ang_lst)))) (setq k (1+ k)) ) (command "") ) ) ) (entdel (car (nth n ent_lst))) (setq inc (+ inc spacing) n (1+ n) ) ) (setq i (1+ i)) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (setvar 'cecolor "256") ;; restore the color "ByLayer" (prompt "\The polylines are evenly spaced using Evenly Spacing the Polylines 2 - REVCLOUD!") (princ) ) This is the short video example how the ESP2R.lsp works. EvenlySpacingPolyline_V2.mp4 Best regards. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.