Jump to content

Block Extraction


Paul Mc

Recommended Posts

Was wondering if someone can help me out with a little routine which would extract the value "elevation" from a selected block and create a point at the insertion of the particular block. I have a drawing with blocks showing the elevation of the ground at certain areas and I need to create a TIN of the ground.

 

Any help would be greatly appreciated.

 

Thank you.

Link to comment
Share on other sites

Do you want to have to select every block, or have them selected automatically? (if automatically, could you provide the exact block name).

 

Also, I am assuming that "elevation" is the attribute tag name?

 

thanks

 

Lee

Link to comment
Share on other sites

Try this for starters (untested and written quickly):

 

(defun c:ept (/ vlst ovar ss elst att zval pt ptlst)
 (setq vlst '("CMDECHO" "OSMODE")
   ovar (mapcar 'getvar vlst)) (mapcar 'setvar vlst '(0 0))
 (if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "[b][color=Red]BNAME[/color][/b]")
       (cons 66 1) (if (getvar "CTAB")(cons 410 (getvar "CTAB"))
             (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq elst (mapcar 'cadr (ssnamex ss)))
     (foreach ent elst
   (setq att (entnext ent))
   (while (not (eq "SEQEND" (cdadr (entget att))))
     (if (eq "ELEVATION" (cdr (assoc 2 (entget att))))
       (setq zval (atof (cdr (assoc 1 (entget att))))))
     (setq att (entnext att)))
   (setq pt (cdr (assoc 10 (entget ent)))
         ptlst (cons (subst zval (last pt) pt) ptlst)))
     (mapcar '(lambda (x) (command "_point" x)) ptlst))
   (princ "\n<!> No Blocks Found <!>"))
 (mapcar 'setvar vlst ovar)
 (princ))

 

Make sure you put your block name in the highlighted part.

Link to comment
Share on other sites

Thanks for the help. Unfortunately the script does not work. It will execute but ends right after it is run.

 

Thanks again,

 

Paul

Link to comment
Share on other sites

Did you edit the routine from Lee, to put the name of the block in place of the red BNAME?

 

Lee would have put the block name in there, but he's not such a good mind reader :)

Link to comment
Share on other sites

Have you got your Points set to a mode and size that shows up? Perhaps a PDMODE and PDSIZE could be incorporated into the routine.

Link to comment
Share on other sites

With PDMODE incorporated.

 

(defun c:ept  (/ vlst ovar ss elst att zval pt ptlst)
 (setq    vlst '("CMDECHO" "OSMODE" "PDMODE")
   ovar (mapcar 'getvar vlst))
 (mapcar 'setvar vlst '(0 0 3))
 (if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 "[color=Red][b]BNAME[/b][/color]")
    (cons 66 1)(if    (getvar "CTAB")(cons 410 (getvar "CTAB"))
            (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq elst (mapcar 'cadr (ssnamex ss)))
     (foreach ent  elst
   (setq att (entnext ent))
   (while (not (eq "SEQEND" (cdadr (entget att))))
     (if (eq "ELEVATION" (cdr (assoc 2 (entget att))))
       (setq zval (atof (cdr (assoc 1 (entget att))))))
     (setq att (entnext att)))
   (setq pt    (cdr (assoc 10 (entget ent)))
         ptlst (cons (subst zval (last pt) pt) ptlst)))
     (mapcar '(lambda (x) (command "_point" x)) ptlst))
   (princ "\n<!> No Blocks Found <!>"))
 (mapcar 'setvar vlst ovar)
 (princ))

Link to comment
Share on other sites

AVALUE

;THE FUNCTION BELOW - Returns the value of an attribute

;SYNTAX (SETQ VARIABLENAME (AVALUE BLOCKNAME "ATTRIBUTENAME"))

(defun avalue (bname aname)

(setq cnt 0)

(setq ent bname)

(while (= cnt 0)

(setq ent (entnext ent))

(setq entl (entget ent))

(setq entn (cdr (assoc 2 entl)))

(if (equal entn aname)

(progn

(setq cnt 1)

(setq aval (cdr (assoc 1 entl)))

);progn

); if

); while

); avalue

NAVALUE
;THE FUNCTION BELOW - Changes value of an attribute to a new value

; SYNTAX (NAVALUE BLOCKNAME "ATTRIBUTETAG" NEWVALUE)

(defun navalue (bname aname naval)

(setq cnt 0)

(setq ent bname)

(while (= cnt 0)

(setq ent (entnext ent))

(setq entl (entget ent))

(setq entn (cdr (assoc 2 entl)))

(if (equal entn aname)

(progn

(setq cnt 1)

(setq entl (subst (cons 1 naval) (assoc 1 entl) entl))

(entmod entl)

);progn

); if

); while

); navalue

 

Gets and replaces block attributes. Could be helpful.

Link to comment
Share on other sites

Thank you for the code HardEight, but I think the OP wanted to put a point at the block insertion point, with z-coordinate taken from the block attribute, and didn't want to replace any attributes.

Link to comment
Share on other sites

Ok, I see, hmmm.. Well maybe he can easily get the Z point with AVALUE,

 

(setq inspoint (avalue BNAME "ELEVATION))

 

of course, he would have to have his blocks sorted by the attribute he was trying to extract...

 

I just love those little routines when trying to get info from blocks, so whenever i get a chance to use them I do :)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...