Incremental Attribute

Hi guys,

i have a polyline of 10,000m, and i want to plot one attribute block on that on the interval of every 1000m. But the block should be plot in incremental number

for example,

DC-1 on 1000m

DC-2 on 2000m

DC-3 on 3000m

the interval may changes to 500m or 2000m but it should follow the proper increment.

I need a lisp t solve this problem....plz help

find out attached drawing for the referance

Test_DC.dwg

Here ... try this code:

(defun c:inat
      (/ cme pli plis inc ptli stpt lapt dis ang noi icl icn cnt)
 (setq cme (getvar 'cmdecho)
osm (getvar 'osmode)
 )
 (setvar 'cmdecho 0)
 (setvar 'osmode 0)
 (setq	pli  (car (entsel))
plis (entget pli)
inc  (getreal "\nSet increment value: ")
ptli (list)
 )
 (foreach ip plis
   (if	(= (car ip) 10)
     (setq ptli
     (append ptli
	     (list
	       (cdr ip)
	     )
     )
     )
   )
 )
 (setq	stpt (car ptli)
lapt (last ptli)
dis  (distance stpt lapt)
ang  (angle stpt lapt)
noi  (fix (/ dis inc))
icl  (list)
icn  1
 )
 (repeat (1- noi)
   (setq icl
   (append icl
	   (list
	     (polar stpt ang (* inc icn))
	   )
   )
   )
   (setq icn (1+ icn))
 )
 (setq cnt 1)
 (foreach blip	icl
   (command "-insert"
     "DC"
     blip
     ""
     ""
     (strcat "DC-"
	     (if (> cnt 9)
	       (itoa cnt)
	       (strcat "0" (itoa cnt))
	     )
     )
   )
   (princ)
   (setq cnt (1+ cnt))
 )
 (setvar 'cmdecho cme)
 (setvar 'osmode osm)
 (princ)
)

(princ)

It only works on single segment polylines!

Thankx CAD89 for ur efforts

This is good for single segment polyline, but i am normally works with multi segment polylines.........

Hey Try This

Note: Before Run This Program Please INSERT Block "DC" on your Drawing

(defun c:Test (/ cmh ss i cnt n l blockname)
   (vl-load-com)
   (setq cmh(getvar 'cmdecho))
  [color="blue"] (setq att (getvar 'attreq))[/color]
(setvar 'cmdecho 0)
       [color="blue"](setvar 'attreq 1)[/color]
   (if (setq ss(car (entsel "\nPick Polyline:")))
    (progn
	    (setq i (getreal "\nIncrement Distance:"))
		(setq n i)
		(setq cnt 1)
		(setq l (vlax-curve-getdistatparam ss (vlax-curve-getendparam ss)))
		(repeat (fix(/ l i))
		    (setq npt(vlax-curve-getpointatdist ss i))
               (if (> cnt 9)
			    (setq Blockname (strcat "DC-"(rtos cnt 2 0)))
				(setq Blockname (strcat "DC-0"(rtos cnt 2 0)))
			)
			(command "_INSERT"[color="blue"] "DC"[/color] npt "" "" blockname)
            (setq cnt(1+ cnt))
			(setq i(+ n i))
		)
	)
   )
(setvar 'cmdecho cmh)
       [color="blue"](setvar 'attreq att)[/color]
(princ)
);defun 
		    
		

Thankx Ganesh...........This is was i was looking for

Solved my problem

Your welcome satishrajdev

Cheers

@Ganesh .

Be careful , the increment would be from right to left if the polyline starts from right to left

Tharwat how to handle problem in that case ?

Suppose that we're talking about a polyline that its start point is on the right side and the end is on the left side , or on the contrary .

You can check the X coordinates of the two points which one of them is bigger or less than the other one , depending on that you can

insert your Block definition accordingly .

Tharwat i didn not understand ur point ..i requesting you to please rivise my codes thank you

No worries , I have wrote a routine at the office today in regard to this issue so tomorrow I will post the code because now I am at home.

Try this ...

(defun c:Test (/ *error* IsAttributed Spread_The_Block s d l blk at)
 (vl-load-com)
 ;; Tharwat 15. 01. 2013 ;
 (defun *error* (x)
   (if at
     (setvar 'attdia at)
   )
   (princ "\n*Cancel*")
 )
 (or Doc (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (defun IsAttributed (Doc name / yes)
   (vlax-for o (vla-item (vla-get-blocks Doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq yes t)
     )
   )
   yes
 )
 (defun Spread_The_Block (s l d rm blk / sg i mrk)
   (if rm
     (setq sg  rm
           i   (* d (fix (/ l d)))
           mrk '-
     )
     (setq sg  d
           i   d
           mrk '+
     )
   )
   (repeat (fix (/ l d))
     (vl-cmdf "_.-insert"
              blk
              "_non"
              (vlax-curve-getpointatdist s sg)
              "1."
              "1.0"
              "0."
              (strcat "DC-" (rtos i 2 0))
     )
     (setq sg (+ sg d)
           i  (apply mrk (list i d))
     )
   )
 )
 (setq blk "DC")  ;; Specify Attibuted block name here with one attributes 
 (if (and (if (not (tblsearch "BLOCK" blk))
            (progn (princ "\n Block name is not found in Drawing !!") nil)
            t
          )
          (if (not (IsAttributed Doc blk))
            (progn (princ "\n Block name is not Attributed Block !!") nil)
            t
          )
          (setq d (getreal "\n Increment Distance:"))
          (setq s (car (entsel "\n Select Polyline:")))
     )
   (progn (setq at (getvar 'attdia))
          (setvar 'attdia 0)
          (setq l (vlax-curve-getdistatparam s (vlax-curve-getendparam s)))
          (if (> (car (vlax-curve-getstartpoint s)) (car (vlax-curve-getendpoint s)))
            (Spread_The_Block s l d (rem l d) blk)
            (Spread_The_Block s l d nil blk)
          )
          (setvar 'attdia at)
   )
 )
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)

Tharwat I am impressed thank you

Tharwat I am impressed thank you

I am very happy that you like it .

Tharwat,

I've just discovered your lisp routine for placing attributed blocks along a polyline. It's very good and almost perfect for my requirements and I have a question for you.

Would it be difficult to make the block insert so that it is perpendicular to the polyline (even around a curve) instead of vertical as it is currently?

I'm trying to learn lisp so if you could point me in the right direction I'm willing to give it a try!

regards

John

Welcome to CADTutor rayboy.

Can you please give an example showing your desire goal of the program regardless of the fore-said program in this thread ?

Upload a sample drawing if you can .

Or here is the way of how to play with the angle .

NOTE: Don't forget to localize the variable 'p' in the program.

(vl-cmdf "_.-insert"
              blk
              "_non"
              (setq p (vlax-curve-getpointatdist s sg))
              "1."
              "1.0"
              (/ (* (angle '(0. 0. 0.)
                           (vlax-curve-getfirstderiv
                             s
                             (vlax-curve-getparamatpoint s p)
                           )
                    )
                    180.0
                 )
                 pi
              )
              (strcat "DC-" (rtos i 2 0))
     )

Welcome to CADTutor rayboy.

 

Can you please give an example showing your desire goal of the program regardless of the fore-said program in this thread ?

 

Upload a sample drawing if you can .

Thank you Tharwat, it's nice to be here.

I've attached a simple drawing showing an example.

The top example is what the lisp produces. The bottom example is what I would like.

The blocks should be perpendicular to the polyline (like teeth on a gear wheel).

It would be nice as well if it could insert a block at the start point (0.0) and number them 0.0, 0.5, 1.0, 1.5 etc.

kp-test.dwg

This is not perfect but it does the trick very well and now you can select more objects than just a polyline.

Try it.

(defun c:Test (/ *error* do isattributed spread_the_block s d l blk vals
              p
             )
 ;; Tharwat 26. 08. 2015 ;
 (defun *error* (x)
   (if vals
     (mapcar 'setvar '(attdia dimzin) vals)
   )
 )
 (defun isattributed (doc name / yes)
   (vlax-for o (vla-item (vla-get-blocks doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq yes t)
     )
   )
   yes
 )
 (defun spread_the_block (s l d blk / sg i mrk)
   (setq sg  d
         i   d
         mrk '+
   )
   (vl-cmdf "_.-insert"
            blk
            "_non"
            (setq p (vlax-curve-getstartpoint s))
            "1."
            "1.0"
            (/ (* (angle '(0. 0. 0.)
                         (vlax-curve-getfirstderiv
                           s
                           (vlax-curve-getparamatpoint s p)
                         )
                  )
                  180.0
               )
               pi
            )
            (strcat "DC-" "0.0")
   )
   (repeat (fix (/ l d))
     (vl-cmdf "_.-insert"
              blk
              "_non"
              (setq p (vlax-curve-getpointatdist s sg))
              "1."
              "1.0"
              (/ (* (angle '(0. 0. 0.)
                           (vlax-curve-getfirstderiv
                             s
                             (vlax-curve-getparamatpoint s p)
                           )
                    )
                    180.0
                 )
                 pi
              )
              (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 (not (isattributed do 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)
           (vla-endundomark do)
    )
 )
 (*error* nil)
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)(vl-load-com)

Thanks Tharwat, that's getting very close.

I can't get the text to start from 0 (it starts at 0.5) then it doesn't show the decimal place for the whole numbers (it shows 1 instead of 1.0). I've adjusted the RTOS value but it doesn't display the 1.0 format.