Leaderboard

Agree with @GLAVCVS, with cadr you're getting the X coordinate, not Y coordinate.

Is the coordinate order set to Y, X, Z? This could be the error. Try changing cadr to caddr in the line '(setq yval (cadr (assoc 10 edata)))'

Worked perfect, the scale and the color thing is nice. Thank you very much, for you time and help.

I tested it it work perfect. Only thing that is a little bit difficult is selection but I think I can take care of it. Thank you very mach you help me solve my problem.

I tested it, its work fine. Only tune that needs is the take care of the first and the last. Both arrows has to point in one direction. Thank you very much for you time and effort.

Try an another version (vl-load-com) (defun c:BLOCKINSERT ( / ss blkname acadObj doc mspace n dxf_ent vlaobj pr nb_e scl_blk pt lst_pt nbs ang1 ang2 blk lst itm) (setq ss (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>"))) blkname "Stalb" ) (cond ((and ss (tblsearch "BLOCK" blkname)) (setq acadObj (vlax-get-acad-object) doc (vla-get-activedocument acadObj) mspace (vla-get-modelspace doc) ) (if (null (tblsearch "LAYER" "EL_стълб_НН")) (vlax-put (vla-add (vla-get-layers doc) "EL_стълб_НН") 'color 1) ) (repeat (setq n (sslength ss)) (setq dxf_ent (entget (setq ent (ssname ss (setq n (1- n))))) dxf_210 (cdr (assoc 210 dxf_ent)) lst_pt nil) (setq vlaobj (vlax-ename->vla-object ent) pr -1 ) (repeat (setq nb_e (if (zerop (vlax-get vlaobj 'Closed)) (1+ (fix (vlax-curve-getEndParam vlaobj))) (fix (vlax-curve-getEndParam vlaobj)))) (if (not scl_blk) (progn (initget 6) (setq scl_blk (getreal "\nBlock scale?<1>: ")))) (if (not scl_blk) (setq scl_blk 1.0)) (setq pt (vlax-curve-GetPointAtParam vlaobj (setq pr (1+ pr))) lst_pt (cons pt lst_pt) ) (setq nbs (1- (length lst_pt))) ) (foreach pto lst_pt (if (and (not (zerop nbs)) (not (eq (1+ nbs) (length lst_pt)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ang2 (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nbs)))) ) (setq ang1 (if (not (zerop nbs)) (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nbs)))) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ) ang2 ang1 ) ) (if (and (zerop nbs) (not (zerop (vlax-get vlaobj 'Closed)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ang2 (+ pi (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (length lst_pt)))) ) ) (if (and (eq (1+ nbs) (length lst_pt)) (not (zerop (vlax-get vlaobj 'Closed)))) (setq ang1 (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ) ) (setq nbs (1- nbs) blk (vla-InsertBlock mspace (vlax-3d-point pto) blkname scl_blk scl_blk scl_blk 0.0) ) (vlax-put blk 'Layer "EL_стълб_НН") (vlax-put blk 'Color 3) (setq lst (list (cons "Angel_1" ang1) (cons "Angel_2" ang2))) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (vla-get-propertyname x) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) ) ) ) (prin1) )

Thanks, I replaced cadr with caddr, everything is fine.

That's strange, it worked when I tested it here just now... though Angel_2 was inserted 180 degrees the wrong way - try this fix for that (something to look at later for me for a better fix) (defun c:blockinsert ( / ent MyEnt acount EntCoords MyBlock MyBlockName Ang1 Ang2) ;; Initial Values (setq MyBlockName "Stalb") ;; Change this to your block name ;;Sub functions (defun mAssoc ( key lst / result ) ;; Lee Mac: CadTutor forum (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) (defun LM:getvisibilitystate ( blk / vis ) ;; Lee Mac (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) (defun LM:setdynprops ( blk lst / itm ) ;; Lee Mac (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) (defun SetAng ( Ang1 Ang2 MyEnt / ) ;; From Lee Macs LISPs. Change 'cons' "Angle", "Angle1" to suit dynamic block (lm:setdynprops (vlax-ename->vla-object MyEnt) (list (cons "Angel_1" Ang1) (cons "Angel_2" Ang2))) ; Ang in radians ) (defun AddBlock ( BName Pt XScale YScale ZScale / ) ;; Adds block to the drawing (setq NewBlock (entmakex (list '(0 . "INSERT") (cons 2 BName) (cons 10 Pt) (cons 41 XScale) (cons 42 YScale) (cons 43 ZScale) (cons 50 0); ))) ; end setq entmakex, list NewBlock ) ;; End sub functions (setq Ent (car(entsel "Select LW Polyline"))) (setq MyEnt (entget Ent)) (if (or (equal (cdr (assoc 0 MyEnt)) "LWPOLYLINE") ) ; end or (progn (setq EntCoords (massoc 10 MyEnt)) (setq acount 0) (while (< acount (length EntCoords)) ;;Insert (setq MyBlock (AddBlock MyBlockName (nth acount EntCoords) 1 1 1) ) ;;Ang1 (if (= acount 0) ; First point (progn (setq ang1 (angle (nth acount EntCoords) (nth (+ acount 1) EntCoords) )) ; = ang2 ) ; end progn (progn (setq ang1 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ) ; end progn ) ; end if ;;Ang2 (if (= acount (- (length EntCoords) 1)) ; last point (progn (setq ang2 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ; = ang1 ) (progn (setq ang2 (angle (nth acount EntCoords) (nth (+ acount 1) EntCoords) )) ) ) ; end if (SetAng Ang1 Ang2 (entlast)) ;; Sets dynamic block angle (setq acount (+ acount 1)) ) ; end while ) (progn (princ "Polyline not selected") ) ; end progn ) ; end if polyline (princ) ; exit quietly )

Try this. Not sure what you want for attribute values. Can ask once then will be added correctly. Maybe 3 getstring after pick pline. ; https://www.cadtutor.net/forum/topic/98666-block-insert-lisp/ ; arrows by AlanH Aug 2025 (defun c:wow ( / plent co-ord isclosed x obj ang) ;; Set Dynamic Block Property Value - Lee Mac ;; Modifies the value of a Dynamic Block property (if present) ;; blk - [vla] VLA Dynamic Block Reference object ;; prp - [str] Dynamic Block property name (case-insensitive) ;; val - [any] New value for property ;; Returns: [any] New value if successful, else nil (defun LM:setdynpropvalue ( blk prp val ) (setq prp (strcase prp)) (vl-some '(lambda ( K ) (if (= prp (strcase (vla-get-propertyname k))) (progn (vla-put-value K (vlax-make-variant val (vlax-variant-type (vla-get-value K)))) (cond (val) (t)) ) ) ) (vlax-invoke blk 'getdynamicblockproperties) ) ) (setq plent (entsel "\nPick pline")) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))) (setq isclosed (cdr (assoc 70 (entget (car plent))))) (setq x 0) (command "-insert" "Stalb" (nth x co-ord) 1 1 0 "" "" "") (setq obj (vlax-ename->vla-object (entlast))) (setq ang (angle (nth x co-ord) (nth (+ x 1) co-ord))) (LM:setdynpropvalue obj "Angel_1" ang) (if (= isclosed 1) (progn (setq ang (angle (nth 0 co-ord) (last co-ord) )) (LM:setdynpropvalue obj "Angel_2" ang) ) ) (repeat (- (length co-ord) 2) (command "-insert" "Stalb" (nth (setq x (1+ x)) co-ord) 1 1 0 "" "" "") (setq obj (vlax-ename->vla-object (entlast))) (setq ang (angle (nth x co-ord) (nth (+ x 1) co-ord))) (LM:setdynpropvalue obj "Angel_1" ang) (setq ang (angle (nth x co-ord) (nth (- x 1) co-ord))) (LM:setdynpropvalue obj "Angel_2" ang) ) (command "-insert" "Stalb" (nth (setq x (1+ x)) co-ord) 1 1 0 "" "" "") (setq obj (vlax-ename->vla-object (entlast))) (setq ang (angle (nth x co-ord) (nth (- x 1) co-ord))) (LM:setdynpropvalue obj "Angel_2" ang) (if (= isclosed 1) (progn (setq ang (angle (nth x co-ord) (nth 0 co-ord) )) (LM:setdynpropvalue obj "Angel_1" ang) ) ) (princ) )

Try this: No error checking, or checking you have selected the correct polyline. Works only of LWPolylines - comment again if you want this to do 3d polylines as well. I haven't put many notes in this as to how it works, but look through and see if it makes sense. One thing I noticed is your sample block - to me - was an anonymous block name - which might have been the error you noticed (some technical stuff made it so) - as a fix I copied the block entities and created a new block, calling it "Arrow". You'll need to set your block name in the LISP below to the block you want to use (see (Setq MyBlockName "Arrow") line for what to change). (defun c:blockinsert ( / ent MyEnt acount EntCoords MyBlock MyBlockName Ang1 Ang2) ;; Initial Values (setq MyBlockName "Arrow") ;; Change this to your block name ;;Sub functions (defun mAssoc ( key lst / result ) ;; Lee Mac: CadTutor forum (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) (defun LM:getvisibilitystate ( blk / vis ) ;; Lee Mac (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) (defun LM:setdynprops ( blk lst / itm ) ;; Lee Mac (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) (defun SetAng ( Ang1 Ang2 MyEnt / ) ;; From Lee Macs LISPs. Change 'cons' "Angle", "Angle1" to suit dynamic block (lm:setdynprops (vlax-ename->vla-object MyEnt) (list (cons "Angle" Ang1) (cons "Angle1" Ang2))) ; Ang in radians ) (defun AddBlock ( BName Pt XScale YScale ZScale / ) ;; Adds block to the drawing (setq NewBlock (entmakex (list '(0 . "INSERT") (cons 2 BName) (cons 10 Pt) (cons 41 XScale) (cons 42 YScale) (cons 43 ZScale) (cons 50 0); ))) ; end setq entmakex, list NewBlock ) ;; End sub functions (setq Ent (car(entsel "Select LW Polyline"))) (setq MyEnt (entget Ent)) (if (or (equal (cdr (assoc 0 MyEnt)) "LWPOLYLINE") ) ; end or (progn (setq EntCoords (massoc 10 MyEnt)) (setq acount 0) (while (< acount (length EntCoords)) ;;Insert (setq MyBlock (AddBlock MyBlockName (nth acount EntCoords) 1 1 1) ) ;;Ang1 (if (= acount 0) ; First point (progn (setq ang1 (angle (nth acount EntCoords) (nth (+ acount 1) EntCoords) )) ; = ang2 ) ; end progn (progn (setq ang1 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ) ; end progn ) ; end if ;;Ang2 (if (= acount (- (length EntCoords) 1)) ; last point (progn (setq ang2 (angle (nth acount EntCoords) (nth (- acount 1) EntCoords) )) ; = ang1 (setq ang2 (angle (nth (- acount 1) EntCoords) (nth acount EntCoords) )) ) (progn (setq ang2 (angle (nth (+ acount 1) EntCoords) (nth acount EntCoords) )) ) ) ; end if (SetAng Ang1 Ang2 (entlast)) ;; Sets dynamic block angle (setq acount (+ acount 1)) ) ; end while ) (progn (princ "Polyline not selected") ) ; end progn ) ; end if polyline (princ) ; exit quietly )

I'd be forgetting AI for now, handy for snippets but still not quiet there. Lee Mac has some great resources: https://lee-mac.com/dynamicblockfunctions.html might be what you are looking for. Also search this forum for Massoc Implementations which can be used to return a list of vertices. (defun mAssoc ( key lst / result ) (foreach x lst (if (= key (car x)) (setq result (cons (cdr x) result)) ) ) (reverse result) ) Will give a list of points along a polyline where key in this case is 10, and list is the polyline entity description from maybe (entget (car (entsel))) Dynamic blocks: (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) (lm:getdynprops (vlax-ename->vla-object (car(entsel))) ) returns the format and names of dynamic block variables and setting them with: (defun LM:setdynprops ( blk lst / itm ) (setq lst (mapcar '(lambda ( x ) (cons (strcase (car x)) (cdr x))) lst)) (foreach x (vlax-invoke blk 'getdynamicblockproperties) (if (setq itm (assoc (strcase (vla-get-propertyname x)) lst)) (vla-put-value x (vlax-make-variant (cdr itm) (vlax-variant-type (vla-get-value x)))) ) ) ) (lm:setdynprops (vlax-ename->vla-object (car(entsel))) (list (cons "Angle" 0) (cons "Angle2" pi))) Inserting the blocks can be as simple as (command "insert" "Stylb_NN_nov" -Point- "" "" "") where point is the points along the massoc returned list (ignore the 1st and last point) and then use (entlast) in the setdynprops line instead of (car(entsel)) Might be a pointer to get you making something up.