motee-z Posted July 25, 2015 Share Posted July 25, 2015 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 26, 2015 Share Posted July 26, 2015 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 Quote Link to comment Share on other sites More sharing options...
motee-z Posted July 26, 2015 Author Share Posted July 26, 2015 the arrow created by divide will be in the same direction and will not show different direction according to elevation even using lintype Quote Link to comment Share on other sites More sharing options...
BIGAL Posted July 26, 2015 Share Posted July 26, 2015 You could check start and end points elevation, then reverse pline so arrow goes correct way. Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted July 26, 2015 Share Posted July 26, 2015 (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 December 18, 2020 by Stefan BMR Quote Link to comment Share on other sites More sharing options...
eldon Posted July 26, 2015 Share Posted July 26, 2015 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. Quote Link to comment Share on other sites More sharing options...
motee-z Posted July 26, 2015 Author Share Posted July 26, 2015 very great job mr stefan thank you very much it is perfect also thanks to MR BIGAL and eldon Quote Link to comment Share on other sites More sharing options...
David Bethel Posted July 26, 2015 Share Posted July 26, 2015 (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 July 27, 2015 by David Bethel 3D Arrow, better spacing Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted July 26, 2015 Share Posted July 26, 2015 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. Quote Link to comment Share on other sites More sharing options...
motee-z Posted July 26, 2015 Author Share Posted July 26, 2015 Mr stefan can you add elevation to arrow head same elevation on insertion point of 3dpoly Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted July 26, 2015 Share Posted July 26, 2015 (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 December 18, 2020 by Stefan BMR format error fixed Quote Link to comment Share on other sites More sharing options...
motee-z Posted July 26, 2015 Author Share Posted July 26, 2015 thank you Mr stefan for your kindness Quote Link to comment Share on other sites More sharing options...
wo0dy Posted December 18, 2020 Share Posted December 18, 2020 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! Quote Link to comment Share on other sites More sharing options...
Stefan BMR Posted December 18, 2020 Share Posted December 18, 2020 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. Quote Link to comment Share on other sites More sharing options...
wo0dy Posted December 23, 2020 Share Posted December 23, 2020 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! Quote Link to comment Share on other sites More sharing options...
Jonathan Handojo Posted December 28, 2020 Share Posted December 28, 2020 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) ) Quote Link to comment Share on other sites More sharing options...
Mugna101 Posted December 30, 2020 Share Posted December 30, 2020 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? Quote Link to comment Share on other sites More sharing options...
BIGAL Posted December 31, 2020 Share Posted December 31, 2020 Have a close look at this (setq c 0.0 y (/ d 5.0)) Quote Link to comment Share on other sites More sharing options...
wo0dy Posted January 5, 2021 Share Posted January 5, 2021 Thanks a lot Jonathan, works perfect! Quote Link to comment Share on other sites More sharing options...
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.