Incremental Attribute

[rayboy]

Sorry, I forgot to attach the file.

kp-test.dwg

[Tharwat]

I updated the codes and you can go straight to codes from HERE

 

Let me know how you get on with it.

[rayboy]

Tharwat,

 

That's absolutely perfect! Thank you very much for your help.

 

I'm now going to study the routine to find out exactly how it all works and use it to improve my understanding of LISP.

 

Again many, many thanks.

 

John

[Tharwat]

Tharwat,

 

That's absolutely perfect! Thank you very much for your help.

 

I'm now going to study the routine to find out exactly how it all works and use it to improve my understanding of LISP.

 

Again many, many thanks.

 

John

 

Excellent , you are most welcome John and don't hesitate to ask if you encountered any confusion about the codes or need any clarification .

[rayboy]

Hello Tharwat,

 

Your marvellous lisp routine has stopped working correctly since I upgraded to AutoCAD 2016 (that's the only thing I can think of that's changed).

 

It runs as normal but it does not write the attribute value into the block. So all the kilometre posts appear in the correct location but with no numbers in them.

 

Do you have any idea what could be causing this to happen?

 

best regards,

 

John

[Tharwat]

Hi John,

 

Are you still using the same block name with the same properties ?

Did you add any codes to the program ?

 

Can you upload a sample drawing if it is not the same as the one we worked on in this thread?

[Tharwat]

Anyway I have modified the program but did not test it out so try it and let me know how you get on with it.

 

(defun c:Test (/ *error* do spread_the_block s d l blk vals p)
 ;; Tharwat 18. 02. 2016 ;;
 (defun *error* (x)
   (if vals
     (mapcar 'setvar '(attdia dimzin) vals)
   )
 )
 (defun spread_the_block (s l d blk do / sg i mrk sp a)
   (setq sg  d
         i   d
         mrk '+
         sp  (vlax-get (vla-get-activelayout do) 'Block)
   )
   (if (setq a (vla-InsertBlock
                 sp
                 (vlax-3d-point (setq p (vlax-curve-getstartpoint s)))
                 blk
                 1.0
                 1.0
                 1.0
                 (angle '(0. 0. 0.)
                        (vlax-curve-getfirstderiv
                          s
                          (vlax-curve-getparamatpoint s p)
                        )
                 )
               )
       )
     (vla-put-textstring
       (car (vlax-invoke a 'getattributes))
       (strcat "DC-" "0.0")
     )
   )
   (repeat (fix (/ l d))
     (if (setq a
                (vla-InsertBlock
                  sp
                  (vlax-3d-point (setq p (vlax-curve-getpointatdist s sg)))
                  blk
                  1.0
                  1.0
                  1.0
                  (angle '(0. 0. 0.)
                         (vlax-curve-getfirstderiv
                           s
                           (vlax-curve-getparamatpoint s p)
                         )
                  )
                )
         )
       (vla-put-textstring
         (car (vlax-invoke a 'getattributes))
         (strcat "DC-" (rtos i 2 1))
       )
     )
     (setq i  (apply mrk (list i d))
           sg (+ sg d)
     )
   )
 )
 (setq blk      "kptag1"
       do       (vla-get-activedocument (vlax-get-acad-object))
       *incval* (if *incval*
                  *incval*
                  0.5
                )
 )
 ;; Specify Attibuted block name here with one attributes 
 (if
   (and
     (if (not (tblsearch "BLOCK" blk))
       (progn (princ "\nBlock name is not found in Drawing !!")
              nil
       )
       t
     )
     (if (/= 2 (cdr (assoc 70 (tblsearch "BLOCK" blk))))
       (progn (princ "\nBlock name is not Attributed Block !!")
              nil
       )
       t
     )
     (progn (initget 6)
            (setq
              *incval* (cond ((getdist (strcat "\n Increment Distance <"
                                               (rtos *incval* 2 2)
                                               "> :"
                                       )
                              )
                             )
                             (t *incval*)
                       )
            )
     )
     (setq s (car (entsel "\nPick on [Polyline,Line,Arc,Spline]:")))
     (wcmatch (cdr (assoc 0 (entget s)))
              "LWPOLYLINE,LINE,ARC,SPLINE"
     )
   )
    (progn (setq vlas (mapcar 'getvar '(attdia cmdecho dimzin)))
           (mapcar 'setvar '(attdia cmdecho dimzin) '(0 0 0))
           (setq l (vlax-curve-getdistatparam s (vlax-curve-getendparam s)))
           (vla-startundomark do)
           (spread_the_block s l *incval* blk do)
           (vla-endundomark do)
    )
 )
 (*error* nil)
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)(vl-load-com)

Edited February 19, 2016 by Tharwat

[rayboy]

Hello Tharwat,

 

Yes, I'm using the same block etc.

 

Your modified routine is writing the attribute value into the block correctly again. But now the kptag1 block is not perpendicular to the polyline any more. Each instance appears at different random angles to the polyline.

 

many thanks for your help.

 

John

[Tharwat]

I am sorry , I did not have much time yesterday to test the codes before posting them.

 

CODES UPDATES ABOVE

 

Try it now.

[rayboy]

You're the man Tharwat! It's working again.

 

many thanks for your time and help.

 

john

Edited February 19, 2016 by rayboy
terrible spelling

[Tharwat]

Your the man Tharwat! It's working again.

 

many thanks for your time and help.

 

john

 

You're most welcome.

 

Codes updated again to look / be shorter.