Insert Block update Attribute based on surface elevation

[Hammer.John.J]

I think alot of people could use this and maybe somebody could help with this idea?

I want to be able to insert a block with an attribute and have the attribute take on the elevation of the current surface, and if possible change elevation if i remake the surface.
(the last part of that is not really as important as the first part)

Here's an example of 4 different spot grade's we use, problem is we have blocks for every scale (20,40,60, & 100) however they all use the same attribute name they are just scaled differently (they do NOT get scaled when inserted, they are originally drawn to scale)

i attached my 40 scale blocks.
fyi i'm using LDT06

[Jeff_M]

How much "help" would you like? I can provide you with the utility to get the elevation from the current surface if you'd like to create the part to insert the block and modify the attribute with the elevation.

[Jeff_M]

.... however they all use the same attribute name ....

No, they don't....
TXTT
TXTR
TXTL
TXTB

Looks like 4 different TAGs to me.......they all use the same Prompt (although one is in lower case and the others are uppercase) but that doesn't help......

However, since there is only ONE attribute, the Tag won't matter.

[Hammer.John.J]

i have ldd so it will ping the surface

[Hammer.John.J]

How much "help" would you like? I can provide you with the utility to get the elevation from the current surface if you'd like to create the part to insert the block and modify the attribute with the elevation.

yeah... i should learn lisp at some point but i have no idea how to code sorry for being vague. what ever you can do to help. if you only want to write a piece that is cool. i have some other code that was done here that might help, i attached the lisp.

[Jeff_M]

Here ya go, John......at the end is the code for 1 of the blocks. You can make up the others by just changing the name of the function "c:surf40" to whatever names you want to use for the command and changing the block name to match....

(defun attsurf	(bname / acadobj aecapp aecProj aecsurfs aecsurf aecutil e-n
		 emsg pt# selev appstr versn *error* att blk space)
  (defun *error* (msg / objlist)
    (setq objList
	   (reverse
	     (list acadobj aecapp aecProj aecsurfs aecsurf aecutil)
	   )
    )
    (vl-catch-all-apply
      '(lambda ()
	 (mapcar 'vlax-release-object objlist)
       )
    )
    (if	msg
      (princ (strcat "\n" msg))
    )
    (princ)
  )
  ;;;;;
  (setq appstr (cond ((= (setq versn (atoi (substr (getvar "acadver") 1 2))) 15) "2")
		     ((= versn 16) "4")
		     ((= versn 17) "6")
		     )
	)
  (setq	acadObj	 (vlax-get-acad-object)
	space    (vla-get-modelspace (vla-get-activedocument acadObj))
	aecApp	 (vla-getinterfaceobject acadObj (strcat "Aecc.Application." appstr))
	aecProj	 (vlax-get aecApp "Activeproject")
	aecSurfs (vlax-get aecProj "Surfaces")
	aecSurf	 (vlax-get aecSurfs "Currentsurface")
	aecUtil	 (vlax-get (vlax-get aecApp "activedocument") "Utility")
  )
  (if (and (= aecSurf "")
	   (> (vlax-get aecSurfs "count") 0)
      )
    (setq aecSurf (vlax-get (vlax-invoke aecSurfs "item" 0) "name"))
  )
  (if (= aecSurf "")
    (princ
      "\nNo surfaces defined, try again after creating a surface."
    )
    (progn
      (setq aecSurf (vlax-invoke aecSurfs "item" aecSurf))
      (while (setq
	       pt# (getpoint "\nPoint to label on the current surface: ")
	     )
	(setq e-n (vlax-invoke aecutil "xytoeastnorth" pt#))
	(setq selev (vlax-invoke
		      aecSurf
		      "getelevation"
		      (car e-n)
		      (cadr e-n)
		    )
	)
	;;Insert your block insertion and attribute setting here
	(setq blk (vlax-invoke space 'insertblock pt# bname 1.0 1.0 1.0 0.0))
	(setq att (car (vlax-invoke blk 'getattributes)))
	(vla-put-textstring att (rtos selev 2 2))
	;(princ (strcat "\nElevation at point = " (rtos selev)))
      )
    )
  )
  (*error* nil)
)

;;;make as many of these as you need, this is for the SPOTL40 block
(defun c:surf40 ()
  (attsurf "spotl40")
  (princ)
  )

Note that there is a bug in the LDD API when using surfaces in lisp that sometimes raises an error. If you encounter this, just re-open the drawing. This will clear the lisp cache.....although in rare cases a full exit from Acad is required. I have not seen it cause any data or dwg corruption, it is more of a nuisance.....and I did not see it at all in the testing I did with this routine.

Enjoy!
Jeff

[Hammer.John.J]

oh man that is going to be sweet!

[Hammer.John.J]

YEAH that bug... my LDT 06 crashes HARD and OFTEN because of some runtime error with that lisp, lol. i just save often I mean it just fatal errors out and bam, game over.

[Jeff_M]

Could you elaborate, John, on the crashes? I have just run this routine in a drawing for over 10 minutes, start/stop/ESC'ing out, etc. and have not had it crash even once. I mean, I am trying really hard to force a crash with no luck.....

Jeff

[Hammer.John.J]

we have multiple users looking at the same project folder so it could be related to that? not sure. it hasn't done it lately but i added the lisp through cui instead of through appload. haven't had a crash since i did that. it would do it during any command it would just fatal error out on a run time error than bam, no more cad, lol. i don't care the thing does what i need it to do and if i figure out why it's crashing i'll be sure to let ya know.

thanks again this is awesome, i bet tons of people could use this!