Block Attribute with measure command..

[aaryan]

Hi all,

 

I am very thankful to all members who helped me for my previous requests to find out the solutions. i am again in seek of your's help. Please.

 

I am trying to make a lisp routine which will insert block with a single attribute on every point with its distance in kilometre post, almost same as measure command but after a bit exercise i found nothing helpful for me as i am still a newbie and still learning lisp.

 

Here is what i have made so far.

 

(defun c:KP(/ a g b c d e f)
 (setq a (car (entsel "Pick Polyline:"))
g (entget a)
b (cdr (assoc 10 g))
c (getreal "Specify KP interval in <metres>:")
d (getfiled "Select KP Block" "*.*" "dwg" 4))
 (command "_.insert" d b 1 1 0 "0.0")
 (Setq e (entget (entlast))
f (cdr (assoc 2 e)))
 (command "_.measure" a "B" f "Y" c)
 (princ))

KP.dwg

 

Attached drawing is the one i am trying to achieve and i made it manually inserting it.Can it be possible can anyone please guide me through..

Thanks in advance.

[Tharwat]

You should have the block KP into your current opened drawing .

 

Not needed

Edited June 4, 2012 by Tharwat

[aaryan]

Thanks Tharwat,

But if possible can the block perpendicular to the rotation of pline, and second thing is the distance i specify must be the attribute with the inserted block. (e.g specify distance:200m => 0.0,0.2,0.4,0.6,.0.8...n)

Thanks and Regards

[pBe]

Thanks Tharwat,

But if possible can the block perpendicular to the rotation of pline, and second thing is the distance i specify must be the attribute with the inserted block. (e.g specify distance:200m => 0.0,0.2,0.4,0.6,.0.8...n)

Thanks and Regards

 

I assume that its not always a 2 point polyline. or is it?

[aaryan]

No it wil not. As i can assume the routine has to go through polyline vertices and as per them the rotation should take place. i think so but not sure.

[pBe]

Thanks Tharwat,

But if possible can the block perpendicular to the rotation of pline, and second thing is the distance i specify must be the attribute with the inserted block. (e.g specify distance:200m => 0.0,0.2,0.4,0.6,.0.8...n)

Thanks and Regards

 

Pseudo code:

Collect points on polyline per interval value:

Use those points to determine the angle for every segment

ATTREQ is 1

Use native _insert command

 

HTH

 

Another PSeudo code:

Insert block on startpoint.

Measure

Collect entities create after measure command (ssadd)

"EDIT" the first block inserted using the first index of the selection set as rotation reference

"REPLACE" the rest or "EDIT" the rest of the blocks for increment number 1.1 1.2

[aaryan]

Thanks i will do it and come back if i stuck anywhere.

[aaryan]

For rotation, how can you get the angle of the 1st and 2nd vertices respectively and with entnext 3rd and so on.

[pBe]

(defun c:AngP ()
     (setq pline (car (entsel)))
     (setq points (mapcar 'cdr (vl-remove-if-not '(lambda (j)
                              ( = (car j) 10)) (setq ent (entget pline)))))
     (setq anglesP (mapcar '(lambda (k l)
                                  (angle k l)) points (cdr points)))
     (print anglesP)
     (princ)
     )

 

Angles in radians

[aaryan]

Thanks pBe

[pBe]

Thanks pBe

 

Holler if you need help

[fixo]

Try this one from my oldies,

just quickly rewitten to your suit

 
;; written by Fatty T.O.H. () 2004 * all rights removed
;; edited 6/5/10
;; edited 6/10/10
;; edited 6/11/10
;; edited 6/4/12
;; Stationing
;;load ActiveX library
(vl-load-com)
;;local defuns
;;//
(defun start (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getstartpoint curve
)
)
)
)
)
)
;;//
(defun end (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getendpoint curve
)
)
)
)
)
)
;;//
(defun pointoncurve (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
pt
)
)
)
)
)
;;//
(defun paramatpoint (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getparamatpoint curve
pt
)
)
)
)
)
;;//
(defun distatpt (curve pt)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatpoint curve
(vlax-curve-getclosestpointto curve pt)
)
)
)
)
)
;;//
(defun pointatdist (curve dist)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getclosestpointto curve
(vlax-curve-getpointatdist curve dist)
)
)
)
)
)
;;//
(defun curvelength (curve)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatparam curve
(- (vlax-curve-getendparam curve)
(vlax-curve-getstartparam curve)
)
)
)
)
)
)
;;//
(defun distatparam (curve param)
(vl-catch-all-apply (function (lambda()
(vlax-curve-getdistatparam curve
param
)
)
)
)
)
;;//
(defun statlabel (num step div)
(if (zerop step)
"0.0"
(rtos (/ (* (rem num div) step) 1000.) 2 1)
)
)
;;//
(defun insertstation (acsp bname pt rot tag num step div / block)
(vl-catch-all-apply
(function (lambda()
(setq block (vlax-invoke-method acsp 'InsertBlock pt bname 1 1 1 rot))
)
)
)
(changeatt block tag (statlabel num step div))
block
)
;;//
(defun changeatt (block tag value / att)
(setq atts (vlax-invoke block 'GetAttributes))
(foreach att atts
(if (equal tag (vla-get-tagstring att))
(vla-put-textstring att value)
)
)
)
;;// written by VovKa (Vladimir Kleshev)
(defun gettangent (curve pt)

(setq param (paramatpoint curve pt)
ang ((lambda (deriv)
(if (zerop (cadr deriv))
(/ pi 2)
(atan (apply '/ deriv))
)
)
(cdr (reverse
(vlax-curve-getfirstderiv curve param)
)
)
)
)
ang
)
;;------------------- main program ---------------------------;
(defun C:STKP (/ *error* acsp adoc block cnt div en ent label
lastp lay leng lnum mul num pt rot sign start step)

(defun *error* (msg)
(if msg (princ (strcat "\nError! " msg)))
(princ)
)

(setvar "dimzin" 2)
(setq lay (getvar "clayer"))
(setvar "clayer" "0")
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
acsp (vla-get-block (vla-get-activelayout adoc))
)

(if (not (tblsearch "block" "KP"))(progn
(alert "Block \"KP\" does not exist. Exit...")
(princ)))
(initget 6)
(setq step (getreal "\nEnter step <200>: "))
(cond ((not step)
(setq step 200)))

(if
(setq
ent (entsel
"\nSelect curve near to the start point >>"
)
)
(progn
(setq en (car ent)
pt (pointoncurve en (cadr ent))
leng (distatparam en (vlax-curve-getendparam en))
)
(setq num (fix (/ leng step))
)
(setq div (fix step ) )

(setq mul (rem leng step))

(if (not (zerop mul))
(setq lastp T)
(setq lastp nil)
)
(if (> (- (paramatpoint en pt)
(paramatpoint en (vlax-curve-getstartpoint en))
)
(- (paramatpoint en (vlax-curve-getendpoint en))
(paramatpoint en pt)
)
)
(progn
(setq start leng
sign -1
)
)
(progn
(setq start (distatparam en (vlax-curve-getstartparam en))
sign 1
)
)
)

(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(setq cnt 0)
(repeat (1+ num)
(setq pt (pointatdist en start)
rot (gettangent en pt)
)
(setq block
(insertstation
acsp
"KP"
(vlax-3d-point pt)
rot
"KP"
cnt
step
div)
)

(setq cnt (1+ cnt)
start (+ start (* sign step))
)
)

(if lastp
(progn
(if (= sign -1)
(progn
(setq pt (vlax-curve-getstartpoint en)
rot (gettangent en pt)
)
)
(progn
(setq pt (vlax-curve-getendpoint en)
rot (gettangent en pt)
)
)
)
(setq block
(insertstation
acsp
"KP"
(vlax-3d-point pt)
rot
"KP"
(1- cnt)
0
div)
)
(setq label (rtos (+ (/ (* (rem num div) step) 1000.)(/ mul 1000.))2 2))
(changeatt block "KP" label)
)
)
(setvar "clayer" lay)
(vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
)
)
(princ "\nNothing selected")
)
(*error* nil)
(princ)
)
(prompt "\n >>> Type STKP to execute...")
(prin1)

 

~'J'~

[pBe]

Try this one from my oldies,

just quickly rewitten to your suit

 

Nice code Oleg,

 

Guys, never noticed this before, Are the attribute blokcs behave diffrently when you run "measure", somehow it lost the ability to edit the attributes, can anyone verify this?

[fixo]

Thanks pBe,

but code is looking ugly

I'm so lazy to rewrite them completely,

Regards,

 

Oleg

[aaryan]

thanks Fixo

[aaryan]

I am very much THANKFUL TO ALL OF YOU.

FIXO You rocks......

My problem solved..

Thanks Again.

[fixo]

No problem, glad to help

 

~'J'~

[pBe]

pl FWIW

 

 

(defun c:Kp2 ( / _Entnext  _insert a flag el a i tlen data ipt ns ss)
(vl-load-com)
;;;  Measure with Attribute  ;;;
;;;        pBe   ;;;
(setvar 'osmode 0) 
(defun _Entnext  (e) (if (setq e (entnext e))
                 (cons e (_Entnext e))))  
(defun _insert (pt bn ro)
(vlax-invoke (vlax-get (vla-get-ActiveLayout
 (vla-get-activedocument (vlax-get-acad-object)))
                  'Block) 'InsertBlock  pt bn 1 1 1 ro))
(defun _attfunc (enam  p ent f tl / an ad)
(setq an (entnext enam) ad (entget an))
(while (= "ATTRIB" (cdr (assoc 0 ad)))
     (if (= "KP" (strcase (cdr (assoc 2 ad))))
           (vla-put-textstring (vlax-ename->vla-object an)
                 (rtos (/ (progn
                           (setq dist (vlax-curve-getDistAtPoint a p))
                           (if f dist ( - tl dist)  )) 1000) 2 1))
           )
     (setq an (entnext an)
           ad (entget an)))
)

(if (and
(tblsearch "BLOCK" "KP")
       (setq a (entsel "\nSelect object to measure: "))
       (eq (cdr (assoc 0 (entget (car a)))) "LWPOLYLINE")
(setq b (cond ((getdist
        (strcat "Specify KP interval in metres or [Pick two points] <"
                     (rtos (setq b
              (cond ( b ) ( 100 ))
            ) 2 2) ">: " ))) ( b ))
 ))
(progn
(setq el (entlast) ss (ssadd))
(command "_.measure" (vlax-curve-getClosestPointTo (car a) (cadr a))
     "B" "KP" "Y" b)
(setq a (car a))
(mapcar '(lambda ( x ) (ssadd x ss)) (_Entnext el))
(command "_Attsync" "_Name" "KP")
(setq tlen   (vlax-curve-getDistAtParam a (vlax-curve-getEndParam a)))
((lambda ( i / e )  
(setq ns (ssadd))
(while (setq e (ssname ss (setq i (1+ i))))
(if (equal (cdr (assoc 0 (entget e))) "INSERT")
 (ssadd e ns)) )) -1 )
(setq ss ns)
(setq flag (if (> (vlax-curve-getDistAtPoint a
               (cdr (assoc 10 (entget (ssname ss 0))))) b) T))
(repeat (setq i (sslength ss))
    (setq e (ssname ss (setq i (1- i))))
       (setq ipt (cdr (assoc 10 (entget e))))
 (_attfunc e ipt a flag tlen) 
)
(setq data (if flag (list (vlax-curve-getStartPoint a)
                         (ssname ss 0))
                   (list (vlax-curve-getEndPoint a)
                         (entlast))))
(setq att (_insert (car data)
               "KP"
               (if flag
                     (angle (car data)
                            (cdr (assoc 10 (entget (cadr data)))))
                     (angle (cdr (assoc 10 (entget (cadr data))))
                            (car data)))))
(_attfunc (vlax-vla-object->ename att) (car data) a flag tlen)
(setq ss nil)
)
 )
(princ)
     )

 

This code utilizes the native "_measure" command.

Edited June 6, 2012 by pBe

[aaryan]

Nice code too.. Thanks pBe.

[fixo]

Hey pBe, your rouine is very nice,

Regards,

 

Oleg