Direction of Polylines

[Guest]

Thank you eldon ....anyway

[marko_ribar]

If this can help you with speed :

 

(defun c:setarrowlinetype ( / curve catch fname f )
 (vl-load-com)
 (while (setq catch (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-isplanar (list (setq curve (car (entsel "\nPick curve to see its direction")))))))
   (if catch (prompt "\nPicked entity isn't curve, or missed picking... Try again..."))
 )
 (vla-copy (vlax-ename->vla-object curve))
 (setq cc (entlast))
 (setq fname (vl-filename-mktemp nil nil ".lin"))
 (setq f (open fname "w"))
 (write-line "*ARROW,Arrow ->->->->->->->->->->->->->->->->->->->->" f)
 (write-line "A,15.00,-2.50,[\">\",arrows-direction,S=5.00,R=0.0,X=-6.30951,Y=-2.1429],-2.50" f)
 (close f)
 (command "_.-style" "arrows-direction" "simplex.shx")
 (while (> (getvar 'cmdactive) 0) (command ""))
 (command "_.-linetype" "l" "ARROW" fname)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (command "_.change" cc "" "p" "lt" "ARROW" "s" (/ (getvar 'viewsize) 250.0) "c" 1 "")
 (command "_.-style" "Standard")
 (while (> (getvar 'cmdactive) 0) (command ""))
 (princ)
)

(defun c:removearrowlinetype nil
 (entdel cc)
 (command "_.-purge" "lt" "ARROW" "n" "_.-purge" "st" "arrows-direction" "n")
 (setq cc nil)
 (princ)
)

(defun c:sdir nil (c:setarrowlinetype))
(defun c:rdir nil (c:removearrowlinetype))

(prompt "\nInvoke with : sdir , and reset to previous - use it just after invoking : rdir")
(princ)

[Guest]

:DNice job marko_ribar . Is it possible when i scroll my mouse roll button automatically delete the arrow line ? Like the previews lisp?

[marko_ribar]

No, this won't work that way, you'll have to type "rdir" just after you saw direction...

 

For multiple selections, here is the code :

(defun c:setarrowlinetype ( / ss i curve cc fname f )
 (vl-load-com)
 (setq fname (vl-filename-mktemp nil nil ".lin"))
 (setq f (open fname "w"))
 (write-line "*ARROW,Arrow ->->->->->->->->->->->->->->->->->->->->" f)
 (write-line "A,15.00,-2.50,[\">\",arrows-direction,S=5.00,R=0.0,X=-6.30951,Y=-2.1429],-2.50" f)
 (close f)
 (command "_.-style" "arrows-direction" "simplex.shx")
 (while (> (getvar 'cmdactive) 0) (command ""))
 (command "_.-linetype" "l" "ARROW" fname)
 (while (> (getvar 'cmdactive) 0) (command ""))
 (if (setq ss (ssget "_:L" '((0 . "POLYLINE,LWPOLYLINE,SPLINE,HELIX,LINE,XLINE,RAY,CIRCLE,ELLIPSE,ARC"))))
   (progn
     (setq i -1)
     (while (setq curve (ssname ss (setq i (1+ i))))
       (vla-copy (vlax-ename->vla-object curve))
       (setq cc (entlast))
       (setq ccl (cons cc ccl))
       (command "_.change" cc "" "p" "lt" "ARROW" "s" (/ (getvar 'viewsize) 250.0) "c" 1 "")
     )
     (command "_.-style" "Standard")
     (while (> (getvar 'cmdactive) 0) (command ""))
   )
   (progn
     (command "_.-style" "Standard")
     (while (> (getvar 'cmdactive) 0) (command ""))
     (prompt "\nInvalid selection set - empty set - restart routine")
   )
 )
 (princ)
)

(defun c:removearrowlinetype nil
 (foreach cc ccl
   (entdel cc)
 )
 (command "_.-purge" "lt" "ARROW" "n" "_.-purge" "st" "arrows-direction" "n")
 (setq ccl nil)
 (princ)
)

(defun c:sdir nil (c:setarrowlinetype))
(defun c:rdir nil (c:removearrowlinetype))

(prompt "\nInvoke with : sdir , and reset to previous : rdir")
(princ)

Note that with this one, you actually don't have to do "rdir" just after "sdir"... You can continue using "sdir" many times, and only at the end when you want clear curves, you can use "rdir"...

 

M.R.

[motee-z]

Hello Marko

would you please find the reason why arrows drawn opposite if arcs exist in polyline

[marko_ribar]

Arcs that are segments of polylines are considered as ordinary arcs... That's why arrows show always their direction CCW - CCW is direction of all arcs, circles, ellipses... Only way to fix this presentation is to convert all plines to 2nd degree splines and apply above posted code to them instead...

 

If you need to show direction I suggest, you use this code to convert plines to splines... But please, save DWG with ordinary polylines as I don't have inverse function for converting splines back to original polylines... And if direction is opposite than it should be, you can use REVERSE command... (but I don't see where is this useful - ordinary entites don't have arrows that represent their direction - this direction is only useful when you have to make some routine that has to have proper direction of curves entity data that is used by routine)...

 

So here is the code...

 

(defun c:lw2spl ( / *error* arc2spl line2spl loop pl e s ss sss )

 (vl-load-com)

 (defun *error* ( msg )
   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 )

 (defun arc2spl ( e / make_spline points q1 q2 a pc f pe ps w )

          (setq q1 (vlax-curve-GetStartParam e)
                q2 (vlax-curve-GetEndParam e)
                a  (/ (- (vlax-curve-GetEndParam e) (vlax-curve-GetStartParam e)) 3.0) ; a - parameter interval... and angle
                pc (mapcar                              ; pc - points on contur
                     (function
                       (lambda (p)
                        (vlax-curve-GetPointAtParam e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                f  (mapcar                               ; f - first deriv on pc
                     (function
                       (lambda (p)
                         (vlax-curve-GetFirstDeriv e p)
                         )
                       )
                     (list q1 (+ q1 a) (- q2 a) q2)
                   )
                pe (mapcar                              ; pe - extra control points for spline construction
                     (function
                       (lambda (p1 p2 d1 d2)
                         (inters p1 (mapcar '+ p1 d1)
                                 p2 (mapcar '+ p2 d2)
                                 nil
                                 )
                       )
                     )
                    pc (cdr pc) f (cdr f)
                   )
                 ps  (list (car pc) (car pe) (cadr pc) (cadr pe) (caddr pc) (caddr pe)  (cadddr pc)) ; ps - control points for spline
                w   (list 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0 (cos (/ a 2)) 1.0)  ; weights for spline
          )

   (defun make_spline ( pts )
     (entmakex
       (append
          '((0 . "SPLINE") (100 . "AcDbEntity") (100 . "AcDbSpline")
             (70 . 4) (71 . 2) (72 . 10) (73 . 7) (74 . 0)
             (42 . 1.0e-010) (43 . 1.0e-010)
             (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 1.0)
             (40 . 2.0) (40 . 2.0) (40 . 3.0) (40 . 3.0) (40 . 3.0))
          pts
       )
     )
   )
   
   (defun points ( p w )
     (apply 'append (mapcar '(lambda (a b) (list (cons 10 a) (cons 41 b))) p w))
   )
   
   (entdel e)
   (make_spline (points ps w))
   
 )
 
 (defun line2spl ( e / sp ep d )
   
   (setq sp (cdr (assoc 10 (entget e)))
         ep (cdr (assoc 11 (entget e)))
         d (distance sp ep)
   )
   
   (entdel e)
   
   (entmakex
     (list
       '(0 . "SPLINE") '(100 . "AcDbEntity") '(100 . "AcDbSpline") '(210 0.0 0.0 1.0) '(71 . 1) '(73 . 2)
       '(42 . 1.0e-010) '(43 . 1.0e-010) '(40 . 0.0) '(40 . 0.0) (cons 40 d) (cons 40 d) (cons 10 sp) (cons 10 ep)
     )
   )
   
 )
 
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))  
 (setq loop T)
 (setq sss (ssget "_I"))
 (if (and sss (eq (cdr (assoc 0 (entget (setq pl (ssname sss 0))))) "LWPOLYLINE")) (setq loop nil))
 (while loop
   (setq pl (car (entsel "\nPick LWPOLYLINE to convert it to SPLINE")))
   (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE") (setq loop nil))
 )
 (setq e (entlast))
 (command "_.explode" pl "")
 (setq ss (ssadd))
 (while (setq e (entnext e))
   (if (eq (cdr (assoc 0 (entget e))) "LINE")
     (progn
       (setq s (line2spl e))
       (ssadd s ss)
     )
   )
   (if (eq (cdr (assoc 0 (entget e))) "ARC")
     (progn
       (setq s (arc2spl e))
       (ssadd s ss)
     )
   )
 )
 (command "_.join" (ssname ss 0) ss "")
 (*error* nil)
 (princ)
)

(defun c:allpls2spls ( / ss i pl )
 (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
 (setq i -1)
 (while (setq pl (ssname ss (setq i (1+ i))))
   (cond
     ( (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
       (sssetfirst nil (ssadd pl))
       (c:lw2spl)
     )
     ( (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< -1 (cdr (assoc 70 (entget pl))) 2))
       (command "_.convertpoly" "l" pl "")
       (sssetfirst nil (ssadd pl))
       (c:lw2spl)
     )
   )
 )
 (princ)
)

M.R.

Edited November 9, 2013 by marko_ribar

[motee-z]

thanks for your reply

do you think this is the only solution

[marko_ribar]

thanks for your reply

do you think this is the only solution

 

Maybe someone else knows more than me... Beside this, this linetype can display only direction of ordinary polylines, if they are fit/quadratic/cubic there is no possibility to convert them to splines of this type and moreover when "sdir" is applied to them if linetype generation isn't enabled direction can't be presented... So keep in mind that you have to enable this option...

 

M.R.

[marko_ribar]

Maybe someone else knows more than me... Beside this, this linetype can display only direction of ordinary polylines, if they are fit/quadratic/cubic there is no possibility to convert them to splines of this type and moreover when "sdir" is applied to them if linetype generation isn't enabled direction can't be presented... So keep in mind that you have to enable this option...

 

M.R.

 

It seems that this is the real answer to your question... Turn on Linetype generation and there is no need to do anything with plines...

 

M.R.

[marko_ribar]

More info here :

 

http://www.theswamp.org/index.php?topic=45657.0

 

M.R.

[motee-z]

thanks marko

[Stefan BMR]

... Is it possible when i scroll my mouse roll button automatically delete the arrow line ? Like the previews lisp?

Hi prodromosm

Maybe I'm too late to the party, but here is my solution

(defun c:test (/ ss i e j p a h)
 (if
   (setq ss (ssget '((0 . "*POLYLINE"))))
    (progn
      (setq h (* 0.05 (getvar 'viewsize)))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (repeat (setq j (fix (vlax-curve-getendparam e)))
          (setq j (1- j)
                p (vlax-curve-getpointatparam e (+ j 0.5))
                a ((lambda (d) (atan (cadr d) (car d))) (vlax-curve-getfirstderiv e (+ j 0.5)))
          )
          (grdraw p (polar p (+ a (* pi 0.9)) h) 3)
          (grdraw p (polar p (- a (* pi 0.9)) h) 3)
        )
      )
    )
 )
 (princ)
)

[Guest]

Thank you Stefan BMR this is exactly wat i ask for ... Never Too Late

[Guest]

Stefan BMR I need two things if you can :

 

1) can you fix to support spine and polylines

2) if is polyline is not clockwise can you change the color of the arrows to be red

 

Thanks

[Stefan BMR]

As it is now, it can be easily changed to support spline too.

But the direction of a spline (CW or CCW) is quite challenging.

If I'll get to a result, I let you know.

[motee-z]

thank you stefan this lisp solve the question exactly

is it easy to make arrows permanent on special layer

[Guest]

As it is now, it can be easily changed to support spline too.

But the direction of a spline (CW or CCW) is quite challenging.

If I'll get to a result, I let you know.

 

Thank you Stefan BMR i will wait .....

[Stefan BMR]

thank you stefan this lisp solve the question exactly

is it easy to make arrows permanent on special layer

You're welcome motee-z

 

Temporary symbols size is 5% of screen height. If you want something permanent you have to decide about arrow size.

Some guys around here uses DIMSCALE or LTSCALE as reference in situations like this, but this method is not exhaustive.

However, if you use standard arrows in dimstyle, this lisp will draw arrows about the size of a current dimension.

(defun c:test (/ *error* acDoc ss i e j p a h)
 (vl-load-com)
 (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark acDoc)

 (defun *error* (m)
   (and m (not (wcmatch (strcase m) "*CANCEL*,*EXIT*,*QUIT*")) (princ (strcat "\nError: " m)))
   (vla-endundomark acDoc)
   (princ)
   )
 
 (if
   (setq ss (ssget '((0 . "*POLYLINE"))))
    (progn
      (setq h (* (getvar 'dimasz) (getvar 'dimscale)))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (repeat (setq j (fix (vlax-curve-getendparam e)))
          (setq j (1- j)
                a ((lambda (d) (atan (cadr d) (car d))) (vlax-curve-getfirstderiv e (+ j 0.5)))
                p (vlax-curve-getclosestpointto e (polar (vlax-curve-getpointatparam e (+ j 0.5)) a (* 0.5 h)))
          )
          (entmake
            (list
              '(0 . "LWPOLYLINE")
              '(100 . "AcDbEntity")
              '(8 . "0")             ;<---- Layer name
              '(100 . "AcDbPolyline")
              '(90 . 3)
              '(70 . 0)
              (cons 10 (polar p (+ a (* pi 0.9)) h))
              (cons 10 p)
              (cons 10 (polar p (- a (* pi 0.9)) h))
            )
          )
        )
      )
    )
 )
 (vla-endundomark acDoc)
 (princ)
)

P.S. This lisp and the former one assumes 2D Polylines in WCS.

[motee-z]

very nice stefan thank you very much

[Guest]

Stefan BMR I hope you don't mind i add in you code SPLINE

 

(defun c:test (/ ss i e j p a h)
 (if
   (setq ss (ssget '((0 . "*POLYLINE,SPLINE"))))
    (progn
      (setq h (* 0.05 (getvar 'viewsize)))
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (repeat (setq j (fix (vlax-curve-getendparam e)))
          (setq j (1- j)
                p (vlax-curve-getpointatparam e (+ j 0.5))
                a ((lambda (d) (atan (cadr d) (car d))) (vlax-curve-getfirstderiv e (+ j 0.5)))
          )
          (grdraw p (polar p (+ a (* pi 0.9)) h) 3)
          (grdraw p (polar p (- a (* pi 0.9)) h) 3)
        )
      )
    )
 )
 (princ)
)

 

I dont know if it is possible to change color of the arrow

if the polyne is CW to be green

if the polyne is CCW to be red