MEASURE OR SOMETHING

[alexandre_benekowski]

Hi folk,

someone could help me....

I´m trying to make a lisp that insert a attribute block with text and insert a sequencial number (insert the block with the sequencial number each 20 meters). I tried but I did´t win. I tried by "measure":

(defun C:ESTACA ()
(setq pl (entsel "\nSelecione a polyline: "))
(command "measure" pl "block" "C:/LISPS ALEXANDRE/BLOCOS/ESTACA" "Y" 20 ";PUT A SEQUENCIAL NUMBER")
)

Thank you!!!

[ВeekeeCZ · Accepted solution]

You gotta figure out some other method. Because this is what HELP of MEASURE command says about blocks with attributes.

"If the block has variable attributes, these attributes are not included."

Try search for it. HERE is what I found. This quy use the MEASURE command as well... 

Or try this written by fixo, see the SWAMP

Spoiler

(defun C:DP  (/ ang ccw coors d step dif dis en 
	      hgt init ip len n obj sign st txp)
;; ========= convert radians to degrees=====================;;
(defun rtd (a)
  (* 180.0 (/ a pi))
)
;;
(defun dif-angle (ang1 ang2 / step)
  (set 'ang1
       (if (> ang2 (+ pi ang1))
	 (+ (* pi 2) ang1)
	 ang1
       )
  )
  (set 'ang2
       (if (> ang1 (+ pi ang2))
	 (+ (* pi 2) ang2)
	 ang2
       )
  )
  (setq step (- ang2 ang1))
)
;;
(defun ccw-test	(pt_list / angle_list)
  (setq	angle_list
	 (mapcar (function (lambda (x y)
			     (angle x y)
			   )
		 )
		 pt_list
		 (cdr pt_list)
	 )
  )
  (if (> (apply	'+
		(mapcar	(function (lambda (x y) (dif-angle x y)))
			angle_list
			(cdr angle_list)
		)
	 )
	 0
      )
    t
    nil
  )
)
;;;written by Luis Esquivel

(defun get-coors (obj / cnt lst)
(setq cnt (fix (vlax-curve-getendparam obj)))
(while (> cnt 0)
  (setq lst (cons (vlax-curve-getpointatparam obj cnt) lst)
	cnt (1- cnt)))
       lst
  )  
;;========= get perpendicular angle to curve ===============;;
;; written by CAB
(defun perp_angle (obj pt / fder)
  
(setq fder (vlax-curve-getfirstderiv obj
                        (vlax-curve-getparamatpoint obj
			  (vlax-curve-getclosestpointto obj pt))))

(if (equal (cadr fder) 0.0 0.001)
           (setq ang (/ pi 2))
           (setq ang (- pi (atan (/ (car fder) (cadr fder)))))
         )
  ang
  )
  
;;=================== entmake text=========================;;
  
  (defun emake-text (pt ang hgt i /)
    (entmake
      (list
	(cons 0 "TEXT")
	(cons 100 "AcDbEntity")
	(cons 100 "AcDbText")
	(cons 1 (strcat (itoa init) "+00"))
	(cons 10 pt)
	(cons 40 hgt)
	(cons 50 ang)
	(cons 51 0.0)
	(cons 11 pt)
	)
      )
    )
  
;;=====================  < main part >  ==================;;
  
  (princ "\n Stationing pipelines ")
  (command "._undo" "e")
  (command "._undo" "g")
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (if 
  (setq obj (vlax-ename->vla-object (car (setq en (entsel)))))
  (progn
    (setq hgt (getreal "\n Enter text height <15>: "))
    (if (not hgt)
    (setq hgt 15)
    )
  (setq init (getint "\n  Enter initial number <0>: "))
  (if (not init)
    (setq init 0)
    )  
  (setq st (cadr en))
  
  (setq len 
         (vlax-curve-getdistatparam obj
	   (vlax-curve-getendparam obj))
	)  
  

  (setq coors (get-coors obj)
	ccw (ccw-test coors)
	)

  (if (not step) 
      (setq step 100)
    ) 
  (setq d (getdist (strcat "\nStep of stations in cm <" (rtos step) ">: ")))
  (if (not d) (setq d step) (setq step d)
    )
  (if (< (vlax-curve-getdistatpoint obj
	   (vlax-curve-getclosestpointto obj st))
       (- (vlax-curve-getdistatpoint obj
		   (vlax-curve-getendpoint obj))
         (vlax-curve-getdistatpoint obj
	   (vlax-curve-getclosestpointto obj st)))
   )
    (progn
    (setq sign 1
	  dis 0)
    )
    (progn
    (setq sign -1
	  dis len)
    )
    )
    
  (setq n (fix (/ len d))
	dif (- len (* n d))
	) 
  
  (repeat (1+ n) 
  (setq ip (vlax-curve-getpointatdist obj dis)
      ang (perp_angle obj ip)
      )

 (command "._-insert" "STA" ip  1 1 (rtd (if ccw (+ ang (/ pi 2))(- ang (/ pi 2)))))

 (setq txp (polar ip (if ccw ang (+ pi ang)) (* hgt 3)));<-- text gap from pipeline
 (emake-text txp (if ccw ang (+ pi ang)) hgt init) 

(setq dis (+ dis (* sign d))) 
(setq init (1+ init))
)
    )
  )
  (setvar "cmdecho" 1)
  (setvar "osmode" 175)
  (command ".undo" "e")
  (princ)
  )
(vl-load-com)
(princ "\nType DP to stationing ")
(princ)

[devitg]

Upload the dwg sample , both, the one with the road and the block itself