Jump to content

Recommended Posts

Posted

Hello freinds

any one can help how to start to make a lisp for draw arrows on 3d polyline

showing water flow direction

as in attached drawing

arrows.dwg

Posted

2 ways use divide and put a arrow block on the pline, or easier way is just make a line type with text but use >

 

*ARROW ------->------>------->-------

A,40,-5.08,[">",STANDARD,S=1.8,R=0.0,X=-1.8,Y=-.9],-3

Posted

the arrow created by divide will be in the same direction and will not show different direction according to elevation even using lintype

Posted

You could check start and end points elevation, then reverse pline so arrow goes correct way.

Posted (edited)

Hi motee-z

 

this one?

;Show flow direction
;Stefan M. - 26.07.2015
(defun c:flow ( / *error* ms ss e l key d n c y p f a p1 p2 p3 ar)
 (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
   )
   (vla-endundomark acDoc)
   (princ)
 )

 (if
   (setq ss (ssget ":E:S" '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))
   (progn
     (or (tblsearch "layer" "arrow") (vla-add (vla-get-layers acDoc) "arrow"))
     (setq e (ssname ss 0)
           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           )
     (initget "Distance Items" 1)
     (setq key (getkword (strcat "\nPolyline length = " (rtos l) "\nChoose a method [Distance/Items]: ")))
     (if
       (eq key "Distance")
       (setq d (getdist "\nDistance between arrows: "))
       (setq n (getint  "\nNumber of arrows: "))
       )
     (if n (setq d (/ l n)))
     (if d
       (progn
         (setq c 0.0 y (/ d 5.0))
         (while (< (setq c (+ c d)) l)
           (setq p (vlax-curve-getpointatdist e c)
                 f (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))
                 a (angle '(0.0 0.0) f)
                 p1 (polar p a (if (minusp (caddr f)) (- y) y))
                 p2 (polar p1 (+ a (* pi 0.5)) (* 0.4 y))
                 p3 (polar p1 (- a (* pi 0.5)) (* 0.4 y))
                 ar (vla-AddPolyline ms
                      (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbDouble '(0 . 8))
                        (append p2 p p3)
                        )
                      )
                 )
           (vla-put-layer ar "arrow")
           (vla-put-closed ar :vlax-true)
           )
         )
       )   
     )
   )
 (*error* nil)
 (princ)
 )
 
Edited by Stefan BMR
Posted

3d polylines used to default to continuous linetype, unless there has been an improvement recently.

 

I would suggest using measure or divide to send arrow shaped blocks along the line.

Posted

very great job mr stefan thank you very much it is perfect also thanks to MR BIGAL and eldon

Posted (edited)

There are some things that can be extracted from a 3dpoly, some are impossible. A constant UCS from segment to segment is not possible

 

[color=#8b4513];++++++++++++ Divide A 3DPOLY Segment ++++++++++++++++++++++++++++[/color]
[color=#8b4513];;ARG -> Start_pt End_pt Arrow_size[/color]
[b][color=BLACK]([/color][/b]defun 3dp-div [b][color=FUCHSIA]([/color][/b]s e a / d q x m p z u r ip[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]grdraw s e 2 3[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq d [b][color=NAVY]([/color][/b]distance s e[b][color=NAVY])[/color][/b]
       q [b][color=NAVY]([/color][/b]max 1 [b][color=MAROON]([/color][/b]fix [b][color=GREEN]([/color][/b]/ d [b][color=BLUE]([/color][/b]* a 3[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
       x [b][color=NAVY]([/color][/b]/ d q[b][color=NAVY])[/color][/b]
       p [b][color=NAVY]([/color][/b]mapcar '- e s[b][color=NAVY])[/color][/b]
       z [b][color=NAVY]([/color][/b]/ x d[b][color=NAVY])[/color][/b]
       m 0.5
       u [b][color=NAVY]([/color][/b]mapcar '[b][color=MAROON]([/color][/b]lambda [b][color=GREEN]([/color][/b]c[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]* c [b][color=BLUE]([/color][/b]/ 1. [b][color=RED]([/color][/b]distance '[b][color=PURPLE]([/color][/b]0 0 0[b][color=PURPLE])[/color][/b] p[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] p[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]repeat q
    [b][color=NAVY]([/color][/b]setq r [b][color=MAROON]([/color][/b]* m z[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]setq ip [b][color=MAROON]([/color][/b]mapcar '+ s [b][color=GREEN]([/color][/b]mapcar '* p [b][color=BLUE]([/color][/b]list r r r[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 2 [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"ARROW"[/color] [b][color=RED]([/color][/b]rtos a 2 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 10 [b][color=BLUE]([/color][/b]trans ip 0 u[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 62 1[b][color=GREEN])[/color][/b]
                   [b][color=GREEN]([/color][/b]cons 210 u[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
    [b][color=NAVY]([/color][/b]setq m [b][color=MAROON]([/color][/b]1+ m[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]list d q u[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

[color=#8b4513];************ Main Program ***************************************[/color]
[b][color=BLACK]([/color][/b]defun c:3dp-arr [b][color=FUCHSIA]([/color][/b]/ a ss i en vn vd pl v[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]initget 6[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]setq a [b][color=NAVY]([/color][/b]getdist [color=#2f4f4f]"\nArrow Length <4>:   "[/color][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]or a [b][color=NAVY]([/color][/b]setq a 4[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]not [b][color=MAROON]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]strcat [color=#2f4f4f]"ARROW"[/color] [b][color=BLUE]([/color][/b]rtos a 2 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"BLOCK"[/color][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]cons 2 [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"ARROW"[/color] [b][color=RED]([/color][/b]rtos a 2 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]cons 70 0[b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]list 10 0 0 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"SOLID"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]cons 39 0[b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 62 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 10 0 [b][color=BLUE]([/color][/b]* a  0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 13 0 [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 11 [b][color=BLUE]([/color][/b]* a  0.25[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 12 [b][color=BLUE]([/color][/b]* a -0.25[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 210 0 1 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"SOLID"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]cons 39 0[b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 62 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 10 0 [b][color=BLUE]([/color][/b]* a  0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 13 0 [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 11 [b][color=BLUE]([/color][/b]* a  0.25[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 12 [b][color=BLUE]([/color][/b]* a -0.25[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]* a -0.5[b][color=BLUE])[/color][/b] 0[b][color=GREEN])[/color][/b]
                     [b][color=GREEN]([/color][/b]list 210 1 0 0[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons -4 [color=#2f4f4f]"&"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 70 8[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]progn
      [b][color=MAROON]([/color][/b]setq i 0[b][color=MAROON])[/color][/b]
      [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]setq en [b][color=BLUE]([/color][/b]ssname ss i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]setq vn [b][color=BLUE]([/color][/b]entnext en[b][color=BLUE])[/color][/b]
                   vd [b][color=BLUE]([/color][/b]entget vn[b][color=BLUE])[/color][/b]
                   pl nil[b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]while [b][color=BLUE]([/color][/b]/= [color=#2f4f4f]"SEQEND"[/color] [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 0 vd[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                    [b][color=BLUE]([/color][/b]setq pl [b][color=RED]([/color][/b]cons [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc 10 vd[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] pl[b][color=RED])[/color][/b]
                          vn [b][color=RED]([/color][/b]entnext vn[b][color=RED])[/color][/b]
                          vd [b][color=RED]([/color][/b]entget vn[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]setq pl [b][color=BLUE]([/color][/b]reverse pl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]setq v 0[b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]repeat [b][color=BLUE]([/color][/b]1- [b][color=RED]([/color][/b]length pl[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     [b][color=BLUE]([/color][/b]3dp-div [b][color=RED]([/color][/b]nth v pl[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]nth [b][color=PURPLE]([/color][/b]1+ v[b][color=PURPLE])[/color][/b] pl[b][color=RED])[/color][/b] a[b][color=BLUE])[/color][/b]
                     [b][color=BLUE]([/color][/b]setq v [b][color=RED]([/color][/b]1+ v[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
             [b][color=GREEN]([/color][/b]setq i [b][color=BLUE]([/color][/b]1+ i[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

 

 

 

-David

Edited by David Bethel
3D Arrow, better spacing
Posted

You're welcome motee-z.

The only thing you have to add is the current layer status. The lisp is not working if the current layer is locked.

Posted

Mr stefan

can you add elevation to arrow head same elevation on insertion point of 3dpoly

Posted (edited)
motee-z said:
Mr stefan

can you add elevation to arrow head same elevation on insertion point of 3dpoly

Sorry motee-z, my mistake.

 

;Show flow direction
;Stefan M. - 26.07.2015
(defun c:flow ( / *error* ms ss e l key d n c y p f a p1 p2 p3 ar)
 (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
   )
   (vla-endundomark acDoc)
   (princ)
 )
 (if
   (eq (vla-get-lock (vla-get-activelayer acdoc)) :vlax-true)
   (progn
     (princ "\nCurrent Layer is locked.")
     (exit)
     )
   )

 (if
   (setq ss (ssget ":E:S" '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))
   (progn
     (or (tblsearch "layer" "arrow") (vla-add (vla-get-layers acDoc) "arrow"))
     (setq e (ssname ss 0)
           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           )
     (initget "Distance Items" 1)
     (setq key (getkword (strcat "\nPolyline length = " (rtos l) "\nChoose a method [Distance/Items]: ")))
     (if
       (eq key "Distance")
       (setq d (getdist "\nDistance between arrows: "))
       (setq n (getint  "\nNumber of arrows: "))
       )
     (if n (setq d (/ l n)))
     (if d
       (progn
         (setq c 0.0 y (/ d 5.0))
         (while (< (setq c (+ c d)) l)
           (setq p (vlax-curve-getpointatdist e c)
                 f (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))
                 a (angle '(0.0 0.0) f)
                 p1 (polar p a (if (minusp (caddr f)) (- y) y))
                 p2 (polar p1 (+ a (* pi 0.5)) (* 0.4 y))
                 p3 (polar p1 (- a (* pi 0.5)) (* 0.4 y))
                 ar (vla-Add3DPoly ms
                      (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbDouble '(0 . 8))
                        (append p2 p p3)
                        )
                      )
                 )
           (vla-put-closed ar :vlax-true)
;;;            (vla-put-color ar (if (minusp (caddr f)) acred acyellow))
           (vla-put-layer ar "arrow")
           )
         )
       )   
     )
   )
 (*error* nil)
 (princ)
 )
 
Edited by Stefan BMR
format error fixed
Posted

thank you Mr stefan for your kindness

  • 5 years later...
Posted

Hi everyone,

this lisp gives me this error:

 

; error: extra right paren on input

 

and I can't find what's wrong with it. Any ideas?

 

Thanks!

Posted
5 hours ago, wo0dy said:

Hi everyone,

this lisp gives me this error:

 

; error: extra right paren on input

 

and I can't find what's wrong with it. Any ideas?

 

Thanks!

I fixed my posts. I think is was about the site's code formatting.

Posted

Hey Stefan, thanks a lot!

Do you think it is possible to make this script so it works for multiple 3D polylines in one command? Nevermind if it's too much trouble though!

If it would be possible, that would be a big time-win for me!

 

Thank you in advance and enjoy your holidays!

Posted

I'll help you out on @Stefan BMR's behalf (that's if he's okay with it ;) )

;Show flow direction
;Stefan M. - 26.07.2015
(defun c:flow ( / *error* ms ss e l key d i n c y p f a p1 p2 p3 ar)	; Variable 'i' localised (Jonathan Handojo)
 (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
   )
   (vla-endundomark acDoc)
   (princ)
 )
 (if
   (eq (vla-get-lock (vla-get-activelayer acdoc)) :vlax-true)
   (progn
     (princ "\nCurrent Layer is locked.")
     (exit)
     )
   )

 (if
   (setq ss (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))	; Modified to multiple selection (Jonathan Handojo)
   (progn
     (or (tblsearch "layer" "arrow") (vla-add (vla-get-layers acDoc) "arrow"))
;;;     (setq e (ssname ss 0)	; Commented (Jonathan Handojo)
;;;           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
;;;           )
     (initget "Distance Items" 1)
     (setq key (getkword "\nChoose a method [Distance/Items]: "))	; Modified (Jonathan Handojo)
     (if
       (eq key "Distance")
       (setq d (getdist "\nDistance between arrows: "))
       (setq n (getint  "\nNumber of arrows: "))
       )
     (repeat (setq i (sslength ss))	; Repeat loop (Jonathan Handojo)
	 (setq i (1- i) e (ssname ss i)		; Curve details moved here (Jonathan Handojo)
           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           )
     (if n (setq d (/ l n)))
     (if d
       (progn
         (setq c 0.0 y (/ d 5.0))
         (while (< (setq c (+ c d)) l)
           (setq p (vlax-curve-getpointatdist e c)
                 f (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))
                 a (angle '(0.0 0.0) f)
                 p1 (polar p a (if (minusp (caddr f)) (- y) y))
                 p2 (polar p1 (+ a (* pi 0.5)) (* 0.4 y))
                 p3 (polar p1 (- a (* pi 0.5)) (* 0.4 y))
                 ar (vla-Add3DPoly ms
                      (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbDouble '(0 . 8))
                        (append p2 p p3)
                        )
                      )
                 )
           (vla-put-closed ar :vlax-true)
;;;            (vla-put-color ar (if (minusp (caddr f)) acred acyellow))
           (vla-put-layer ar "arrow")
           )
         )
       )
	 ) ; Repeat loop end (Jonathan Handojo)
     ) 
   )
 (*error* nil)
 (princ)
 )

 

Posted
On 12/28/2020 at 6:13 PM, Jonathan Handojo said:

I'll help you out on @Stefan BMR's behalf (that's if he's okay with it ;) )


;Show flow direction
;Stefan M. - 26.07.2015
(defun c:flow ( / *error* ms ss e l key d i n c y p f a p1 p2 p3 ar)	; Variable 'i' localised (Jonathan Handojo)
 (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
 (setq ms (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)))
 (vla-startundomark acDoc)
 
 (defun *error* (msg)
   (and
     msg
     (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*"))
     (princ (strcat "\nError: " msg))
   )
   (vla-endundomark acDoc)
   (princ)
 )
 (if
   (eq (vla-get-lock (vla-get-activelayer acdoc)) :vlax-true)
   (progn
     (princ "\nCurrent Layer is locked.")
     (exit)
     )
   )

 (if
   (setq ss (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . 8))))	; Modified to multiple selection (Jonathan Handojo)
   (progn
     (or (tblsearch "layer" "arrow") (vla-add (vla-get-layers acDoc) "arrow"))
;;;     (setq e (ssname ss 0)	; Commented (Jonathan Handojo)
;;;           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
;;;           )
     (initget "Distance Items" 1)
     (setq key (getkword "\nChoose a method [Distance/Items]: "))	; Modified (Jonathan Handojo)
     (if
       (eq key "Distance")
       (setq d (getdist "\nDistance between arrows: "))
       (setq n (getint  "\nNumber of arrows: "))
       )
     (repeat (setq i (sslength ss))	; Repeat loop (Jonathan Handojo)
	 (setq i (1- i) e (ssname ss i)		; Curve details moved here (Jonathan Handojo)
           l (vlax-curve-getdistatpoint e (vlax-curve-getendpoint e))
           )
     (if n (setq d (/ l n)))
     (if d
       (progn
         (setq c 0.0 y (/ d 5.0))
         (while (< (setq c (+ c d)) l)
           (setq p (vlax-curve-getpointatdist e c)
                 f (vlax-curve-getfirstderiv e (vlax-curve-getparamatpoint e p))
                 a (angle '(0.0 0.0) f)
                 p1 (polar p a (if (minusp (caddr f)) (- y) y))
                 p2 (polar p1 (+ a (* pi 0.5)) (* 0.4 y))
                 p3 (polar p1 (- a (* pi 0.5)) (* 0.4 y))
                 ar (vla-Add3DPoly ms
                      (vlax-safearray-fill
                        (vlax-make-safearray vlax-vbDouble '(0 . 8))
                        (append p2 p p3)
                        )
                      )
                 )
           (vla-put-closed ar :vlax-true)
;;;            (vla-put-color ar (if (minusp (caddr f)) acred acyellow))
           (vla-put-layer ar "arrow")
           )
         )
       )
	 ) ; Repeat loop end (Jonathan Handojo)
     ) 
   )
 (*error* nil)
 (princ)
 )

 

 

 

is it possible to change the arrows size? if so. where?

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...