Make Polyline segment vertical or horizontal

November 29, 2017

Hello,

is it possible to select segment of Polyline and make it vertical or horizontal by moving desired vertex (left or right / top or bottom) ?

November 29, 2017

Vertical as in Z?

November 30, 2017

Post a image or dwg to explain what is wanted.

November 30, 2017

I am sorry for unclear description.

Modification just in X-Y as described in attached dwg

Modify_Polyline.dwg

November 30, 2017

Not sure if this works in AutoCAD (see questions in code). It works fine in BricsCAD. The code for a vertical segment is missing but would be very similar. Please test PolySegHor.

(vl-load-com)

(defun c:PolySegHor ( / doc idx lst obj par ref)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq lst (entsel "\nSelect polyline segment near point to change: "))
     (setq obj (vlax-ename->vla-object (car lst)))
     (= "AcDbPolyline" (vla-get-objectname obj)) ; Only for "LWPOLYLINE".
   )
   (progn
     (setq par
       (vlax-curve-getparamatpoint
         obj
         (vlax-curve-getclosestpointto obj (trans (osnap (cadr lst) "nea") 1 0))
       )
     )
     (if (> 0.5 (rem par 1.0))
       (progn
         (setq idx (fix par))
         (setq ref (1+ idx))
       )
       (progn
         (setq idx (fix (1+ par)))
         (setq ref (1- idx))
       )
     )
     (vla-put-coordinate ; Cannot use vlax-put?
       obj
       idx 
       (vlax-3d-point ; 3d point OK?
         (list
           (car (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj idx)))); Cannot use vlax-get?
           (cadr (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj ref))))
           0.0
         )
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

November 30, 2017

Here's another with some pretty colors

(defun c:foo (/ _2d b e i l n o p p1 p2 pa x)
  (defun _2d (p) (and p (setq p (list (car p) (cadr p)))) p)
  ;;RJP - 11.30.2017
  (while
    (and (not b)
	 (setq e (entsel "\nPick near vertex: "))
	 (= "LWPOLYLINE" (cdr (assoc 0 (entget (car e)))))
	 (setq p (vlax-curve-getclosestpointto (car e) (trans (cadr e) 1 0)))
	 (setq pa (fix (+ 0.5 (vlax-curve-getparamatpoint (setq e (car e)) p))))
	 (setq p (_2d (vlax-curve-getpointatparam e pa)))
	 (or (setq p1 (_2d (vlax-curve-getpointatparam e (1+ pa)))) t)
	 (or (setq p2 (_2d (vlax-curve-getpointatparam e (1- pa)))) t)
	 (setq
	   l (vl-remove-if
	       '(lambda (x) (or (member nil x) (equal x p 1e-8) (equal x p1 1e-8) (equal x p2 1e-8)))
	       (list (list (car p) (cadr p1))
		     (list (car p) (cadr p2))
		     (list (car p1) (cadr p))
		     (list (car p2) (cadr p))
		     (list (car p1) (cadr p2))
		     (list (car p2) (cadr p1))
	       )
	     )
	 )
	 (setq n 0)
	 (setq o "1-Red/2-Yellow/3-Green/4-Cyan/5-Blue/6-Magenta/7-White")
    )
     (progn (foreach x l (grdraw p x (setq n (1+ n))))
	    (setq i (vl-string-search (itoa (1+ (length l))) o))
	    (setq o (strcat (substr o 1 i) "EXIT"))
	    (setq i "1-Red")
	    (initget 0 (vl-string-translate "/" " " o))
	    (if	(= (setq i (cond ((getkword (strcat "\n[" o "]<" i ">: ")))
				 (i)
			   )
		   )
		   "EXIT"
		)
	      (setq b t)
	      (progn (entmod (mapcar '(lambda (x)
					(if (equal (cons 10 (list (car p) (cadr p))) x 1e-8)
					  (cons 10 (nth (1- (fix (atof i))) l))
					  x
					)
				      )
				     (entget e)
			     )
		     )
	      )
	    )
	    (redraw)
     )
  )
  (princ)
)
(vl-load-com)

Edited December 17, 2022 by ronjonp
*fixed formatting mess from forum upgrade 1e-

November 30, 2017

Cool stuff Ron!

Just a few remarks:

Use (redraw) in the end, to prevent a possible confusion when working with 2 adjacent vertices
Add Back or Exit option to the getkword, so the user won't be forced to exit with error if he decides to do so
I'd wrap the whole thing within a (while) loop - but thats a personal taste

November 30, 2017

Perfect, Ron

that is much more than I expected and could imagine (all in one solution).

Just small remark: It work perfectly for Vertex but not for end points.

November 30, 2017

Cool stuff Ron!

Just a few remarks:

Use (redraw) in the end, to prevent a possible confusion when working with 2 adjacent vertices

Add Back or Exit option to the getkword, so the user won't be forced to exit with error if he decides to do so

I'd wrap the whole thing within a (while) loop - but thats a personal taste

Thanks for the feedback .. code updated above.

Website · November 30, 2017

You could also use Parametric dimensioning. To make a segment horizontal add a vertical parametric dimension to the segment and then change its value to 0.0. To make a segment vertical add a horizontal parametric dimension and change its value to zero. You can delete the dimension after the edit.

November 30, 2017

Thank you Roy_043,

in AutoCAD with error: Automation Error. Incorrect number of elements in SafeArray

December 1, 2017

Here is a revised version of my code. Based on the information I have found here I believe it should also work in AutoCAD. The commands are PolySegHor and PolySegVer.

(vl-load-com)

(defun PolySegChange (typ / doc idx lst obj par ptIdx ptRef ref) ; Typ is "HOR" or"VER".
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq lst (entsel "\nSelect polyline segment near point to change: "))
     (setq obj (vlax-ename->vla-object (car lst)))
     (= "AcDbPolyline" (vla-get-objectname obj)) ; Only for "LWPOLYLINE".
   )
   (progn
     (setq par
       (vlax-curve-getparamatpoint
         obj
         (vlax-curve-getclosestpointto obj (trans (osnap (cadr lst) "nea") 1 0))
       )
     )
     (if (> 0.5 (rem par 1.0))
       (progn
         (setq idx (fix par))
         (setq ref (1+ idx))
       )
       (progn
         (setq idx (fix (1+ par)))
         (setq ref (1- idx))
       )
     )
     (setq ptIdx (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj idx))))
     (setq ptRef (vlax-safearray->list (vlax-variant-value (vla-get-coordinate obj ref))))
     (vla-put-coordinate
       obj
       idx
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbdouble '(0 . 1))
         (if (= "HOR" typ)
           (list (car ptIdx) (cadr ptRef))
           (list (car ptRef) (cadr ptIdx))
         )
       )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

(defun c:PolySegHor ()
 (PolySegChange "HOR")
)

(defun c:PolySegVer ()
 (PolySegChange "VER")
)

December 1, 2017

It works nice.

Thank you Roy_043

December 1, 2017

Perfect, Ron
...

Just small remark: It work perfectly for Vertex but not for end points.

I updated the code to work with end points. Give it a try.

December 1, 2017

I updated the code to work with end points. Give it a try.

Thank you very much

I love comprehensive routines as it is now.

December 1, 2017

It works nice.
Thank you Roy_043

I forgot to mention, it works nice also with endpoints.

Thank you as well.

December 4, 2017

I updated the code to work with end points. Give it a try.

Hi,

is it possible to modify it to be working also with POLYLINE, not only LWPOLYLINE pls.?

December 16, 2022

On 11/30/2017 at 1:10 PM, ronjonp said:

Here's another with some pretty colors

(defun c:foo (/ _2d b e i l n o p p1 p2 pa x)
 (defun _2d (p) (and p (setq p (list (car p) (cadr p)))) p)
 ;;RJP - 11.30.2017
 (while
   (and (not b)
 (setq e (entsel "\nPick near vertex: "))
 (= "LWPOLYLINE" (cdr (assoc 0 (entget (car e)))))
 (setq p (vlax-curve-getclosestpointto (car e) (trans (cadr e) 1 0)))
 (setq pa (fix (+ 0.5 (vlax-curve-getparamatpoint (setq e (car e)) p))))
 (setq p (_2d (vlax-curve-getpointatparam e pa)))
 (or (setq p1 (_2d (vlax-curve-getpointatparam e (1+ pa)))) t)
 (or (setq p2 (_2d (vlax-curve-getpointatparam e (1- pa)))) t)
 (setq
   l (vl-remove-if
       '(lambda (x) (or (member nil x) (equal x p 1e- (equal x p1 1e- (equal x p2 1e-))
       (list (list (car p) (cadr p1))
	     (list (car p) (cadr p2))
	     (list (car p1) (cadr p))
	     (list (car p2) (cadr p))
	     (list (car p1) (cadr p2))
	     (list (car p2) (cadr p1))
       )
     )
 )
 (setq n 0)
 (setq o "1-Red/2-Yellow/3-Green/4-Cyan/5-Blue/6-Magenta/7-White")
   )
    (progn (foreach x l (grdraw p x (setq n (1+ n))))
    (setq i (vl-string-search (itoa (1+ (length l))) o))
    (setq o (strcat (substr o 1 i) "EXIT"))
    (setq i "1-Red")
    (initget 0 (vl-string-translate "/" " " o))
    (if	(= (setq i (cond ((getkword (strcat "\n[" o "]<" i ">: ")))
			 (i)
		   )
	   )
	   "EXIT"
	)
      (setq b t)
      (progn (entmod (mapcar '(lambda (x)
				(if (equal (cons 10 (list (car p) (cadr p))) x 1e-
				  (cons 10 (nth (1- (fix (atof i))) l))
				  x
				)
			      )
			     (entget e)
		     )
	     )
      )
    )
    (redraw)
    )
 )
 (princ)
)
(vl-load-com)

Hi everyone! Sorry to return to revive this thread so many years later. I tried Ronjonp's script but it seems like some parenthesis are cut off on the forum. I tried fixing but I'm not experienced with AutoLisp so I couldn't get it in a working state. Do you still have an older working version of that code?

December 17, 2022

On 12/16/2022 at 10:09 AM, Stelus42 said:

Hi everyone! Sorry to return to revive this thread so many years later. I tried Ronjonp's script but it seems like some parenthesis are cut off on the forum. I tried fixing but I'm not experienced with AutoLisp so I couldn't get it in a working state. Do you still have an older working version of that code?

I've updated the code here.

Sign In

Make Polyline segment vertical or horizontal

Recommended Posts

Jozef13

Hippe013

BIGAL

Jozef13

Roy_043

ronjonp

Grrr

Jozef13

ronjonp

lrm

Jozef13

Roy_043

Jozef13

ronjonp

Jozef13

Jozef13

Jozef13

Stelus42

ronjonp

Join the conversation

Tutorials

Forums

Activity