Direction of Polylines

August 2, 2013

Hi to everyone

Does anyone have or know of a LISP application that will automatically place an arrow on a polyline to show what direction it has been drawn?

1) select a polyline

2)Then place an arrow on the pline, which pointing the direction

August 2, 2013

What exactly are you trying to accomplish? What type of drawing is being created?

August 2, 2013

Hi ReMark Look this photo

August 2, 2013

Look Into MEASURE and DIVIDE Commands. They have a block option that can be aligned with the PLINE. -David

August 2, 2013

Or possibly create a linetype with arrows, and temporarily change the polyline's linetype.

August 2, 2013

I need to know if the polyline is clockwise or counter clockwise .I dont want to measure or divide something.I need this because help me in dimensioning

August 2, 2013

Or possibly create a linetype with arrows, and temporarily change the polyline's linetype.

yes i do this but i need something faster . if it possible

August 2, 2013

See Below

Link to original post: http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894

;;Posted by LE at the swamp.org
;;http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
 (if (and fromvertex p2)
   (progn (setq a1 (angle cen fromvertex)
	 a2 (angle cen p2)
   )
   (if (or (< a1 a2) (equal a1 a2 0.001))
     (setq d (* r (- a2 a1)))
     (setq d (* r (- (+ 6.2831853 a2) a1)))
   )
   )
   ;; es un circulo
   (setq d (* r 6.2831853))
 )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
 (setq	dir   (cond ((minusp bulge) -1.0)
	    (t 1.0)
      )
theta (* 4.0 (atan (abs bulge)))
 )
 (if (> theta pi)
   (setq theta	(- (* 2.0 pi) theta)
  dir	(* -1.0 dir)
   )
 )
 (setq	theta (/ theta 2.0)
radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
pc    (polar fromvertex beta radio)
 )
 (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
      (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
 (setq closed (vla-get-closed vla_poly))
 (setq endparam (vlax-curve-getendparam vla_poly))
 (setq param endparam)
 (setq i 0)
 (while (> param 0)
   (setq param (1- param))
   (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
   (if	(vlax-property-available-p vla_poly 'bulge)
     (setq bulge (vla-getbulge vla_poly (fix i)))
   )
   (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
   (setq dis (distance fromvertex nextvertex))
   (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
   (if	(and bulge (not (zerop bulge)))
     (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
     (setq etype "ARC")
     )
     (progn bulge (setq etype "LINE"))
   )
;;;;;;    (if	(not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
   (setq vlist	(cons (list ;; numero vertice
		    (+ i 1)
		    ;; tipo de objeto
		    etype
		    ;; punto medio
		    midpt
		    ;; inicia vertice
		    fromvertex
		    ;; termina vertice
		    nextvertex
		    ;; longitud de curva o recta
;;;;;;	       (if (= eType "ARC")
;;;;;;		 (strcat
;;;;;;		   :rcmPrefixArcText
;;;;;;		   (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;;		 ;; es una recta
;;;;;;		 (rtos dis (rcmd-getUnits-mode) :rcmPrec))
	      )
	      vlist
	)
   )
   (setq i (1+ i))
 )
 (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
 ;; establecer longitud de flecha de acuerdo a la altura de pantalla
 ;; para dibujar las flechas iguales a cualquier nivel de zoom
 (setq unidad (/ (getvar "VIEWSIZE") 15))
 (foreach dat lst_dat
   (setq angf (cadr dat)
  dirf (caddr dat)
  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
  pf2  (polar pfm angf (/ unidad 2.0))
   )
   (if	(= dirf 1)
     (setq pf3	(polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
    pf4	(polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
     )
     (setq pftemp pf1
    pf1	   pf2
    pf2	   pftemp
    pf3	   (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
    pf4	   (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
     )
   )
   (if	flag_dir
     (progn ;; dibujar flecha color verde
     ;; cuando se le cambie de direccion
     (grdraw pf1 pf2 3)
     (grdraw pf2 pf3 3)
     (grdraw pf2 pf4 3)
     )
     (progn ;; dibujar flecha
     (grdraw pf1 pf2 4)
     (grdraw pf2 pf3 4)
     (grdraw pf2 pf4 4)
     )
   )
 )
 (setq flag_dir nil)
)

;;; Command for test...
(defun c:PLD (/ pol obj pol_data)
 (setq	pol	 (car (entsel "\nSelect polyline: "))
obj	 (vlax-ename->vla-object pol)
pol_data (getlwpolydata obj)
 )
 (dib_flechdir
   (setq lst_dat
   (vl-remove
     nil
     (mapcar (function (lambda (i)
			 (if (nth 2 i)
			   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
			 )
		       )
	     )
	     pol_data
     )
   )
   )
 )
 (princ)
)

Edited August 4, 2013 by troggarf

August 2, 2013

Thank you troggarf this is great !!

August 2, 2013

I need to know if the polyline is clockwise or counter clockwise .

You didn't say that. There are lots of CW CCW routines around. -David

August 2, 2013

Thank you David , I dont now if i can find something better , but for now troggarf lisp is just fine.

Thanks a lot

August 4, 2013

See Below

I don't remember where I got this from or who wrote it.

David,

this useful routine was written by LE, posted at theswamp.org

Take a look here: http://www.theswamp.org/index.php?topic=35706.0

The thread deals with a question belonging to this routine, solution is provided in the thread.

Digging up further, LE postet this routine in 2006:

http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894

An oldie, but goldie.

BTW: The link above is worth reading, there is much of impressive code to find.

regards

Wolfgang

August 4, 2013

Thanks wkplan, I have updated the post to reflect the original author and link to where it was found.

thanks

~Greg

August 4, 2013

I don't know why, but recently I've written similar routine that couldn't be posted due to the size of the code... I was absent for a 2 weeks and when I checked sites, the whole topics were erased - large codes can be posted on www.autolisp.com but it was erased and from here www.cadtutor.net and from www.autolisp.com... In the meanwhile I've changed little LM's subfunction for checking point list CLW orientation to suit better possible situations where direction can't be determined - that is when pline lies perpendicular to current UCS - also now is applicable for general case UCS rather than WCS... Also I removed info how to invoke routine (sclw) - setclockwise, so you can put it into startup suite in your acaddoc.lsp if you find it useful... The default setcloskwise is checking by OCS of 2d plines, but if your UCS is parallel to OCS it will assume that you want setting for other entities by UCS and 2d plines by OCS, only if UCS is different than OCS and you want setting by UCS (preferable view for checking is top of UCS), you should enter choice UCS...

Maybe I misunderstood what do you want to accomplish, but I think my code can help you too if you're about to changing orientation (direction) of curve entities...

M.R.

sclw.lsp

Edited September 20, 2013 by marko_ribar

August 5, 2013

Thanks marko_ribar but i need only to know the direction and not to change the direction. troggarf lisp is exactly what i need.

;;Posted by LE at the swamp.org
;;http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
 (if (and fromvertex p2)
   (progn (setq a1 (angle cen fromvertex)
	 a2 (angle cen p2)
   )
   (if (or (< a1 a2) (equal a1 a2 0.001))
     (setq d (* r (- a2 a1)))
     (setq d (* r (- (+ 6.2831853 a2) a1)))
   )
   )
   ;; es un circulo
   (setq d (* r 6.2831853))
 )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
 (setq	dir   (cond ((minusp bulge) -1.0)
	    (t 1.0)
      )
theta (* 4.0 (atan (abs bulge)))
 )
 (if (> theta pi)
   (setq theta	(- (* 2.0 pi) theta)
  dir	(* -1.0 dir)
   )
 )
 (setq	theta (/ theta 2.0)
radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
pc    (polar fromvertex beta radio)
 )
 (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
      (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
 (setq closed (vla-get-closed vla_poly))
 (setq endparam (vlax-curve-getendparam vla_poly))
 (setq param endparam)
 (setq i 0)
 (while (> param 0)
   (setq param (1- param))
   (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
   (if	(vlax-property-available-p vla_poly 'bulge)
     (setq bulge (vla-getbulge vla_poly (fix i)))
   )
   (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
   (setq dis (distance fromvertex nextvertex))
   (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
   (if	(and bulge (not (zerop bulge)))
     (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
     (setq etype "ARC")
     )
     (progn bulge (setq etype "LINE"))
   )
;;;;;;    (if	(not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
   (setq vlist	(cons (list ;; numero vertice
		    (+ i 1)
		    ;; tipo de objeto
		    etype
		    ;; punto medio
		    midpt
		    ;; inicia vertice
		    fromvertex
		    ;; termina vertice
		    nextvertex
		    ;; longitud de curva o recta
;;;;;;	       (if (= eType "ARC")
;;;;;;		 (strcat
;;;;;;		   :rcmPrefixArcText
;;;;;;		   (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;;		 ;; es una recta
;;;;;;		 (rtos dis (rcmd-getUnits-mode) :rcmPrec))
	      )
	      vlist
	)
   )
   (setq i (1+ i))
 )
 (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
 ;; establecer longitud de flecha de acuerdo a la altura de pantalla
 ;; para dibujar las flechas iguales a cualquier nivel de zoom
 (setq unidad (/ (getvar "VIEWSIZE") 15))
 (foreach dat lst_dat
   (setq angf (cadr dat)
  dirf (caddr dat)
  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
  pf2  (polar pfm angf (/ unidad 2.0))
   )
   (if	(= dirf 1)
     (setq pf3	(polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
    pf4	(polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
     )
     (setq pftemp pf1
    pf1	   pf2
    pf2	   pftemp
    pf3	   (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
    pf4	   (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
     )
   )
   (if	flag_dir
     (progn ;; dibujar flecha color verde
     ;; cuando se le cambie de direccion
     (grdraw pf1 pf2 3)
     (grdraw pf2 pf3 3)
     (grdraw pf2 pf4 3)
     )
     (progn ;; dibujar flecha
     (grdraw pf1 pf2 4)
     (grdraw pf2 pf3 4)
     (grdraw pf2 pf4 4)
     )
   )
 )
 (setq flag_dir nil)
)

;;; Command for test...
(defun c:PLD (/ pol obj pol_data)
 (setq	pol	 (car (entsel "\nSelect polyline: "))
obj	 (vlax-ename->vla-object pol)
pol_data (getlwpolydata obj)
 )
 (dib_flechdir
   (setq lst_dat
   (vl-remove
     nil
     (mapcar (function (lambda (i)
			 (if (nth 2 i)
			   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
			 )
		       )
	     )
	     pol_data
     )
   )
   )
 )
 (princ)
)

The only thing i want to change is if someone can the (direction arrow) on top of the polyline .

Thanks

August 5, 2013

Maybe, try with this LineType :

If you are using Arial.ttf font as STANDARD style font

*ARROW,Arrow ->->->->->->->->->->->->->->->->->->->->
A,15.00,-2.50,[">",STANDARD,S=5.00,R=0.0,X=-5.50550,Y=-2.468125],-2.50

Or

If you are using simplex.shx font as STANDARD style font

*ARROW,Arrow ->->->->->->->->->->->->->->->->->->->->
A,15.00,-2.50,[">",STANDARD,S=5.00,R=0.0,X=-6.30951,Y=-2.1429],-2.50

M.R.

Edited August 5, 2013 by marko_ribar

August 5, 2013

Thanks marko_ribar but i need only to know the direction and not to change the direction. troggarf lisp is exactly what i need.

;;Posted by LE at the swamp.org
;;http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
 (if (and fromvertex p2)
   (progn (setq a1 (angle cen fromvertex)
	 a2 (angle cen p2)
   )
   (if (or (< a1 a2) (equal a1 a2 0.001))
     (setq d (* r (- a2 a1)))
     (setq d (* r (- (+ 6.2831853 a2) a1)))
   )
   )
   ;; es un circulo
   (setq d (* r 6.2831853))
 )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
 (setq	dir   (cond ((minusp bulge) -1.0)
	    (t 1.0)
      )
theta (* 4.0 (atan (abs bulge)))
 )
 (if (> theta pi)
   (setq theta	(- (* 2.0 pi) theta)
  dir	(* -1.0 dir)
   )
 )
 (setq	theta (/ theta 2.0)
radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
pc    (polar fromvertex beta radio)
 )
 (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
      (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
 (setq closed (vla-get-closed vla_poly))
 (setq endparam (vlax-curve-getendparam vla_poly))
 (setq param endparam)
 (setq i 0)
 (while (> param 0)
   (setq param (1- param))
   (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
   (if	(vlax-property-available-p vla_poly 'bulge)
     (setq bulge (vla-getbulge vla_poly (fix i)))
   )
   (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
   (setq dis (distance fromvertex nextvertex))
   (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
   (if	(and bulge (not (zerop bulge)))
     (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
     (setq etype "ARC")
     )
     (progn bulge (setq etype "LINE"))
   )
;;;;;;    (if	(not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
   (setq vlist	(cons (list ;; numero vertice
		    (+ i 1)
		    ;; tipo de objeto
		    etype
		    ;; punto medio
		    midpt
		    ;; inicia vertice
		    fromvertex
		    ;; termina vertice
		    nextvertex
		    ;; longitud de curva o recta
;;;;;;	       (if (= eType "ARC")
;;;;;;		 (strcat
;;;;;;		   :rcmPrefixArcText
;;;;;;		   (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;;		 ;; es una recta
;;;;;;		 (rtos dis (rcmd-getUnits-mode) :rcmPrec))
	      )
	      vlist
	)
   )
   (setq i (1+ i))
 )
 (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
 ;; establecer longitud de flecha de acuerdo a la altura de pantalla
 ;; para dibujar las flechas iguales a cualquier nivel de zoom
 (setq unidad (/ (getvar "VIEWSIZE") 15))
 (foreach dat lst_dat
   (setq angf (cadr dat)
  dirf (caddr dat)
  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
  pf2  (polar pfm angf (/ unidad 2.0))
   )
   (if	(= dirf 1)
     (setq pf3	(polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
    pf4	(polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
     )
     (setq pftemp pf1
    pf1	   pf2
    pf2	   pftemp
    pf3	   (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
    pf4	   (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
     )
   )
   (if	flag_dir
     (progn ;; dibujar flecha color verde
     ;; cuando se le cambie de direccion
     (grdraw pf1 pf2 3)
     (grdraw pf2 pf3 3)
     (grdraw pf2 pf4 3)
     )
     (progn ;; dibujar flecha
     (grdraw pf1 pf2 4)
     (grdraw pf2 pf3 4)
     (grdraw pf2 pf4 4)
     )
   )
 )
 (setq flag_dir nil)
)

;;; Command for test...
(defun c:PLD (/ pol obj pol_data)
 (setq	pol	 (car (entsel "\nSelect polyline: "))
obj	 (vlax-ename->vla-object pol)
pol_data (getlwpolydata obj)
 )
 (dib_flechdir
   (setq lst_dat
   (vl-remove
     nil
     (mapcar (function (lambda (i)
			 (if (nth 2 i)
			   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
			 )
		       )
	     )
	     pol_data
     )
   )
   )
 )
 (princ)
)

The only thing i want to change is if someone can the (direction arrow) on top of the polyline .

Thanks

marko_ribar can you convert this code?

August 5, 2013

Have you tried loading LineType definitions I provided you? You can copy pline, change linetype, set linetype scale factor and see what is direction of pline... Then, you can delete copy of pline that is above original...

M.R.

August 5, 2013

marko_ribar you dont read my post

yes i do this but i need something faster . if it possible

August 5, 2013

you don't read my post

That is a common failing in the forum. Everyone does it from time to time. Do not get excited and chastise because you might end up getting no replies. But instead marvel how more than one person has thought of the same possible solution

Sign In

Direction of Polylines

Recommended Posts

Guest

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Steven P

enthralled

Posted Images

ReMark

Guest

David Bethel

eldon

Guest

Guest

troggarf

Guest

David Bethel

Guest

wkplan

troggarf

marko_ribar

Guest

marko_ribar

Guest

marko_ribar

Guest

eldon

Join the conversation

Steven P

enthralled

Tutorials

Forums

Activity