A real challenge! Solve with LISP/VBA

Thank you for viewing! I am an avid AutoCAD user (currently 2007) and I can fumble my way through Excel-style VBA but I have no knowledge of the language for LISP. If someone could offer suggestions or even help me with this code I would greatly appreciate it! Really!!

Here is the tedious, time consuming and painful MANUAL process I find myself going through all too often...(Problem)

-I have a model space full of "closed" P-lines that never overlap or intersect each other. I have a block (lets call it "Block A") that contains two attributes: "Area" & "Perimeter". I have 1 copy of Block A per p-line and each Block A resides within the confines of of a given p-line.

I then MANUALLY do the following for each p-line (there are sometimes hundreds):

-Select Block A

-Edit Attribute

-Select Perimeter Attribute and Edit Field

-Field Category:Objects ; Field Names:Object ; Object Type: Polyline ; Property:Length ; Select Object and pick the p-line closest to (that surrounds) the block; Click OK and REPEAT for Area assigning the Property:Area; Click Ok and move to the next block to MANUALLY REPEAT at nausea!

Essentially I'm using a block to pull the geometry for Area and Perimeter of each P-line. I want to use the block because it comes into play later but that's superfluous to this problem.

What I'd like to do is have a code that automatically assigns the P-line surrounding a given block to that block to pull these two attributes. I believe this could be achieved by writing a code that loops through all copies of a selected block (all Block A's in model space), one at a time, then calculates the each distance from the current Block A's centroid to each of the closed P-line's centroid, then assigns the p-line with the shortest centroid-centroid distance to that block's two attributes and continues to loop through each block until all p-lines are assigned to their closest block. End result should show text values (in Block A) that correspond to the length and area of the surrounding p-line.

Easy right?

Please feel free to constructively criticize my logic and PLEASE help me with the code

Why would you do this? Because you'll salvage the sanity and time of a human being through your knowledge and wisdom And because you feel sympathy for a guy with a good idea but lacking the knowledge to implement it!

If you would post a sample DWG file it might be a simple LISP task.

Are the plines on a particular layer?

Are the plines CLOSED & not last vertex on first vertex?

Are the blocks on a particular layer?

is the block name always the same?

Are the attribute TAG's always the same? "Area" & "Perimeter"

PS

Are the drawing UNITS to be placed in the Perimeter attribute or is some conversion needed?

Are the drawing UNITS to be placed in the Area attribute or is some conversion needed?

My drawings are in inches for UNITS but I would want feet & inches in the Perimeter and for

area I would likely wand square feet.

If you would post a sample DWG file it might be a simple LISP task.

---Posted

Are the plines on a particular layer?

---They will all be on the same layer but I'd like for that layer name to be variable. I'd like to have a prompt that asks to select one instance of a p-line that represents the layer.

Are the plines CLOSED & not last vertex on first vertex?

---Assume Plines are CLOSED. There could be an instance or two where they are vertex-vertex but not closed but in an effort to prevent that I do a "Quick Select" for all plines on the given layer and globally assign them the property of CLOSED. Does it really matter? I don't know.

Are the blocks on a particular layer?

---Assume the blocks are on the same layer. I'd like a similar prompt to select the block to use and for the selection to determine what layer it is on and what the block name is.

is the block name always the same?

---See above.

Are the attribute TAG's always the same? "Area" & "Perimeter"

---This one is kind-of tricky. I intend for my block to have consistent TAGs but the reallity is, for the first 3 (of 5) attributes in my block, I rely on another person's block to populate the attributes. My tags are:

-NAME1

-NAME2

-RMNO.

-LF

-SF

I use the commands "blockreplace" and "attsync" to replace the original block (which has only 3 tags and are hopefully the same as my first 3) and populate NAME1,NAME2,RMNO. on my block. At that point I go through and manually update the LF & SF TAGS by selecting the p-line. I am worried about the potential for my block to have different TAGs than a given drawing i am trying to replace blocks on. If the LISP routine must specify the TAG, could it be adjustable? I suppose I could always edit the lisp myself for the actual TAG?

PS

Are the drawing UNITS to be placed in the Perimeter attribute or is some conversion needed?

---My drawing UNITS property is set to Architectural (Always will be). I have attached an image of how I am currently (manually) assigning to field's attribute. My block remembers these settings (exept I have to click on PROPERTY:"Length" everytime i select a pline because it defaults to Area). If there is a better way to setup the block, by all means let me know. All that matters to me is that I get Linear Feet out of Perimeter and Square Feet out of Area.

Are the drawing UNITS to be placed in the Area attribute or is some conversion needed?

---See Above.

My drawings are in inches for UNITS but I would want feet & inches in the Perimeter and for area I would likely wand square feet.

---I too use Linear Feet for Perimeter and Square Feet for Area.

It may also be helpful to know that my end game is to get each block's 5 attributes into an excel spreadsheet (or .csv, whatever). I use the command EATTEXT to extract my block's attributes to a spreadsheet. I have attached a few .jpg's to show the EATTEXT extraction and the Excel end game (I concatenate Name1 & Name2 with a space in between to give me the final room name).

Thank you so much for your response! I am eager to see what solutions you may have to offer! Again, thank you!

Polyline_to_Block.dwg

This is the first draft, so give it a try.

;|
Pseudo Code
Switch to Model Space
Get Closed Plines in model space
Convert to a list if plines
Loop the List
 Get vertex points of the pline
 Get any block w/ atts within the points
 Get Area & Length of pline
 Put Atts for Area & Length
End Loop

Note to report: No Block Found
               Too many blocks found
               Failed Put Atts
|;


;;  Version 1.0 beta
;;  CAB 07/26/2008

(defun c:AreaBlockUpdate( / ss lst pl-ent pl-vertex-lst vla-obj pl-area pl-length
                        count bc atts att blk)
 (vl-load-com)
 ;;  Get Closed Plines in model space
 (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE")  (-4 . "&")  (70 . 1) (67 . 0))))
   (progn
     (vl-cmdf "._zoom" "_E") ; Extents
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
           bc 0)
     (foreach pl-ent lst ; Loop through all Plines
       ;; Get vertex points of the pline
       (setq pl-vertex-lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl-ent))))
       (if (setq ss (ssget "_CP" pl-vertex-lst '((0 . "INSERT") (66 . 1))))
         ;;  Caution: the area must be on the screen for this to work properly - CAB
         (progn
           (setq vla-obj (vlax-ename->vla-object pl-ent)
           	 pl-area  (/ (vla-get-area vla-obj) 144.0)
           	 pl-length (/ (vlax-curve-getDistAtParam pl-ent (vlax-curve-getEndParam pl-ent)) 12.0)
            )
          (if (> (sslength ss) 1)
          	(prompt "\nError - More than one block in Polyline. ")
          )
          ;;  Put the atts 
          (setq count -1)
          (while (< (setq count (1+ count)) (sslength ss))
            (setq blk   (vlax-ename->vla-object (ssname ss count))
                  atts (vlax-invoke blk "getattributes")
            )
            (foreach att atts
              (if (member (setq tag (vla-get-tagstring att)) '("SF" "LF"))
                (progn
                  (cond
                    ((= tag "SF") (setq value (strcat (rtos pl-area 2 1) " SQ. FT.")))
                    ((= tag "LF") (setq value (rtos pl-length 4)))
                  )
                  (vla-put-textstring att value)
                )
              )
            )
            (setq bc (1+ bc))
            (vla-update blk)
          )
         )
         (prompt "\nError - No block found in Polyline. ")
       )
     ) ; foreach
     (prompt (strcat "\n-=< " (itoa bc) " blocks updated  >=-"))
   )
 )
 (princ)
)

My friend, I thank you! At first glance it appear to be doing what I asked except that the perimeter seems to be a factor of 12 off (in other words, the pline measures 36 LF but the block's attribute shows 3'-0"). I was going through the code, trying to make sense of it, but I don't know lisp. I'm sure it is just a matter of putting a multiplier of 12 on the value.

Also, what point on the block are you using to define its location with respect the the pline? I was playing with the blocks, moving them around and running the routine to check which pline it took, and it seemed to be assuming the bottom left corner of the block, as opposed to the center point. Is that the case? Can it be relocated?

Thanks again for your help!

Also,

I noticed the zoom to extents and your note about the block having to be visible... what is this doing?

Is it finding all blocks? I don't see how it is specific to a specific block or layer. I'm guessing you left it generalized for testing?

The line that you need to change for length is this:

            	  pl-length (/ (vlax-curve-getDistAtParam pl-ent (vlax-curve-getEndParam pl-ent)) 12.0)

New line is this:

            	  pl-length (vlax-curve-getDistAtParam pl-ent (vlax-curve-getEndParam pl-ent))

Also, what point on the block are you using to define its location with respect the the pline? I was playing with the blocks, moving them around and running the routine to check which pline it took, and it seemed to be assuming the bottom left corner of the block, as opposed to the center point. Is that the case? Can it be relocated?

As long as the BLOCK is within the pline the routine will find it. That part of the code uses ssget function which requires that the objects be visiable on the screen.

That is why the ZOOM.

Here is another version to try. The length error is changed.

Are you sure the Area is correct? as I divide it by 144.

This version asks the user to select or press enter for default.

Not sure the block Name selection is necessary.

;;======================================================
;;    Version 2

;|
Pseudo Code
Switch to Model Space
Get Closed Plines in model space
Convert to a list if plines
Loop the List
 Get vertex points of the pline
 Get any block w/ atts within the points
 Get Area & Length of pline
 Put Atts for Area & Length
End Loop

Note to report: No Block Found
               Too many blocks found
               Failed Put Atts
|;


;;  Version 1.1 beta
;;  CAB 07/26/2008

(defun c:AreaBlockUpdate( / ss lst pl-ent pl-vertex-lst vla-obj pl-area pl-length
                        count bc atts att blk pl-layer bl-name)
 (vl-load-com)
 (if (/= (getvar "CTAB") "Model")
   (command "._Model")
 )
 (while
   (progn
     (setq pl-layer (entsel "\nSelect Pline for layer or Enter for <Room Finish Line>."))
     (cond
       ((and pl-layer (/= (cdr(assoc 0 (entget (car pl-layer)))) "LWPOLYLINE")
              (princ "\nMust be a polyline, Try Again."))) ; stay in Loop
       (pl-layer ; got object, get layer & exit Loop
          (setq pl-layer (cdr(assoc 8 (entget (car pl-layer))))) nil)
       (t (setq pl-layer "Room Finish Line") nil) ; nul response, exit loop
     )
   )
 )
 
 (while
   (progn
     (setq bl-name (entsel "\nSelect Block for name or Enter for <Room_Takeoff>."))
     (cond
       ((and bl-name (/= (cdr(assoc 0 (entget (car bl-name)))) "INSERT")
              (princ "\nMust be a BLOCK, Try Again."))) ; stay in Loop
       (bl-name (setq bl-name (cdr(assoc 2 (entget (car bl-name))))) nil)
       (t (setq bl-name "Room_Takeoff") nil)
     )
   )
 )
 
 ;;  Get Closed Plines in model space on selected Layer
 (if (setq ss (ssget "_X" (list (cons 8 pl-layer)'(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(67 . 0))))
   (progn
     (vl-cmdf "._zoom" "_E") ; Extents
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
           bc 0)
     (foreach pl-ent lst ; Loop through all Plines
       ;; Get vertex points of the pline
       (setq pl-vertex-lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl-ent))))
       ;;  Get INSERT within pline with attributes and selected Block Name
       (if (setq ss (ssget "_CP" pl-vertex-lst (list '(0 . "INSERT") '(66 . 1)(cons 2 bl-name))))
         ;;  Caution: the area must be on the screen for this to work properly - CAB
         (progn
           (setq vla-obj   (vlax-ename->vla-object pl-ent)
           	  pl-area   (/ (vla-get-area vla-obj) 144.0)
           	  pl-length (vlax-curve-getDistAtParam pl-ent (vlax-curve-getEndParam pl-ent))
            )
          (if (> (sslength ss) 1)
          	(prompt "\nError - More than one block in Polyline. ")
          )
          ;;  Put the atts 
          (setq count -1)
          (while (< (setq count (1+ count)) (sslength ss))
            (setq blk   (vlax-ename->vla-object (ssname ss count))
                  atts (vlax-invoke blk "getattributes")
            )
            (foreach att atts
              (if (member (setq tag (vla-get-tagstring att)) '("SF" "LF"))
                (progn
                  (cond
                    ((= tag "SF") (setq value (strcat (rtos pl-area 2 1) " SQ. FT.")))
                    ((= tag "LF") (setq value (rtos pl-length 4)))
                  )
                  (vla-put-textstring att value)
                )
              )
            )
            (setq bc (1+ bc))
            (vla-update blk)
          )
         )
         (prompt "\nError - No block found in Polyline. ")
       )
     ) ; foreach
     (prompt (strcat "\n-=< " (itoa bc) " blocks updated  >=-"))
   )
 )
 (princ)
)

Area is definitely correct. Perimeter is now correct. Thanks!

However, when i renamed my block to "room2" and selected it when prompted, it did not take? Ideas?

Code adjusted, copy it again..

Off to dinner.

My friend, I think you did it! Thank you so very much!!!

I hope the routine serves you well.

Enjoy.

I'm verry impressed by this code.

I run this on a floorplan with 300 rooms, could not believe that it works so quick!

But it did !

Think this will be one of my all time favorites!

Thankyou CAB for coding, and thanks to brody for his idea and thoughts.

Greetings from germany,

Wolfgang

Welcome to Cadtutor & from Florida, USA.

Glad you like it.

CAB,

is there a short way to hatch these areas, where no block had been found?

I tried to modify your program by inserting

(command "._hatch" "SOLID" "O" pl-ent "" "")   

instead of:

(prompt "\nError - No block found in Polyline. ")

but get no luck.

regards

Wolfgang

Try this Wolfgang:

;;======================================================
;;    Version 2

;|
Pseudo Code
Switch to Model Space
Get Closed Plines in model space
Convert to a list if plines
Loop the List
 Get vertex points of the pline
 Get any block w/ atts within the points
 Get Area & Length of pline
 Put Atts for Area & Length
End Loop

Note to report: No Block Found
               Too many blocks found
               Failed Put Atts

Edited by Lee Mac to include Hatching when no Block is found.
|;


;;  Version 1.1 beta
;;  CAB 07/26/2008

(defun c:AreaBlockUpdate( / ss lst pl-ent pl-vertex-lst vla-obj pl-area pl-length
                        count bc atts att blk pl-layer bl-name)
 (vl-load-com)
 (if (/= (getvar "CTAB") "Model")
   (command "._Model")
 )
 (while
   (progn
     (setq pl-layer (entsel "\nSelect Pline for layer or Enter for <Room Finish Line>."))
     (cond
       ((and pl-layer (/= (cdr(assoc 0 (entget (car pl-layer)))) "LWPOLYLINE")
              (princ "\nMust be a polyline, Try Again."))) ; stay in Loop
       (pl-layer ; got object, get layer & exit Loop
          (setq pl-layer (cdr(assoc 8 (entget (car pl-layer))))) nil)
       (t (setq pl-layer "Room Finish Line") nil) ; nul response, exit loop
     )
   )
 )
 
 (while
   (progn
     (setq bl-name (entsel "\nSelect Block for name or Enter for <Room_Takeoff>."))
     (cond
       ((and bl-name (/= (cdr(assoc 0 (entget (car bl-name)))) "INSERT")
              (princ "\nMust be a BLOCK, Try Again."))) ; stay in Loop
       (bl-name (setq bl-name (cdr(assoc 2 (entget (car bl-name))))) nil)
       (t (setq bl-name "Room_Takeoff") nil)
     )
   )
 )
 
 ;;  Get Closed Plines in model space on selected Layer
 (if (setq ss (ssget "_X" (list (cons 8 pl-layer)'(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(67 . 0))))
   (progn
     (vl-cmdf "._zoom" "_E") ; Extents
     (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
           bc 0)
     (foreach pl-ent lst ; Loop through all Plines
       ;; Get vertex points of the pline
       (setq pl-vertex-lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget pl-ent))))
       ;;  Get INSERT within pline with attributes and selected Block Name
       (if (setq ss (ssget "_CP" pl-vertex-lst (list '(0 . "INSERT") '(66 . 1)(cons 2 bl-name))))
         ;;  Caution: the area must be on the screen for this to work properly - CAB
         (progn
           (setq vla-obj   (vlax-ename->vla-object pl-ent)
                 pl-area   (/ (vla-get-area vla-obj) 144.0)
                 pl-length (vlax-curve-getDistAtParam pl-ent (vlax-curve-getEndParam pl-ent))
            )
          (if (> (sslength ss) 1)
              (prompt "\nError - More than one block in Polyline. ")
          )
          ;;  Put the atts 
          (setq count -1)
          (while (< (setq count (1+ count)) (sslength ss))
            (setq blk   (vlax-ename->vla-object (ssname ss count))
                  atts (vlax-invoke blk "getattributes")
            )
            (foreach att atts
              (if (member (setq tag (vla-get-tagstring att)) '("SF" "LF"))
                (progn
                  (cond
                    ((= tag "SF") (setq value (strcat (rtos pl-area 2 1) " SQ. FT.")))
                    ((= tag "LF") (setq value (rtos pl-length 4)))
                  )
                  (vla-put-textstring att value)
                )
              )
            )
            (setq bc (1+ bc))
            (vla-update blk)
          )
         )
         (progn
           (setvar "HPNAME" "SOLID")
           (vl-cmdf "_.-hatch" "_S" pl-ent "" ""))
       )
     ) ; foreach
     (prompt (strcat "\n-=< " (itoa bc) " blocks updated  >=-"))
   )
 )
 (princ)
)

Lee,

you did it once again!

I changed one little thing:

(progn
(setvar "HPNAME" "SOLID") 
                   (vl-cmdf "[color=Blue]_.-bhatch[/color]" "_S" pl-ent "" ""))  

I had to change _.-hatch to _.-bhatch, because the normal hatch-function do'nt accept the arguments given above.

And thinking about your changes, I thougt it would be a good idea, just to add the same piece of code to another part of the program:

Change:

(if (> (sslength ss) 1)
              (prompt "\nError - More than one block in Polyline. ")

to

(if (> (sslength ss) 1)
(progn
(setvar "HPNAME" "SOLID")                                 
(vl-cmdf "_.-bhatch" "SOLID" "_S" pl-ent "" ""))
 [color=Red];[/color](prompt "\nError - More than one block in Polyline. ")

will also hatch polylines with more then one block inside:wink:

Thinking about youre HPNAME-idea, maybee it is a good choice to store the hatch-name in separate variables. And the hatch-color too...

User can then take a choice at program-start, how to mark polylines he has to check out again.

But that can be done easy at programming start, and with the support you gave me for the GetLwClsd.lsp, Lee, I'm sure I will learn my lessons.

regards

Wolfgang

Happy to help Wolfgang, I'm glad you are learning

Lee

Fantastic code, but I'm having an issue with closed polylines with intersecting Vertex points.

The reason I need the points to intersect is that I'm trying to exclude columns etc. from room area so I draw from the wall around the columns and then back to the same point on the wall to close the polyline. What would I need to alter in the lisp code to get this to work?

Thanks