Need some code... Any Lispers wanna take a crack at this?

[crbateman]

My old Lisp days are 20 years gone... I just can't get my head around this one.
I need a routine to process some closed p-line regions, in batches or sometimes one at a time.

I want to:

1) Create a selection set from polywindows or picks, checking that all selections are indeed closed p-lines.

2) Hatch each selection (using the current hatch and layer settings).

3) Find the area of each selection.

4) Insert text at or near the middle of each selection (using the current style and layer settings) indicating the corresponding area measurements.

I wish I could still do these myself, but the skills really do fade with the passage of time...
Thanks for the help!

[Tom Beauford]

This code will select closed polylines and lwpolylines.

 (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))

Next step thru each item in the selection set to label, then hatch. What's your base units and what units do you want for area?

[crbateman]

This code will select closed polylines and lwpolylines.

 (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))

Next step thru each item in the selection set to label, then hatch. What's your base units and what units do you want for area?

I have to deal with many different units, as my plans come from several disciplines. I think just going with the defaults will be OK for this usage. I can convert between units later, where necessary.

[Tom Beauford]

Finding the middle of each selection is the tricky part. Maybe someon else has a better idea, but for now this code places the text at the middle of the objects bounding box. Great for rectangles, less than perfect for irregular objects.

;SqFtFields
; by: Tom Beauford
;^C^C^P(or C:SqFtFields (load "SqFtFields.lsp"));SqFtFields
; (load "SqFtFields.lsp") SqFtFields
(defun c:SqFtFields (/ ss nn en ob )
  (princ "\nSelect closed Polylines ")
  (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1))))
  (repeat (setq nn (sslength ss))
    (setq en (ssname ss (setq nn (1- nn)))
   ob (vlax-ename->vla-object en)
   obid (vla-get-objectid ob)
    )
    (vla-getboundingbox ob 'll 'ur)
    (setq plarea (vlax-get-property ob 'Area)
          lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos obid 2 0) ">%).Area \\f \"%lu2%pr0%qf1%ps[±, ft²]%th44\">%")        ; 1=1 foot
          pntlist  (mapcar 'vlax-safearray->list (list ll ur))
          tpt (list(/(+(caar pntlist)(caadr pntlist))2.0)(/(+(cadar pntlist)(cadadr pntlist))2.0))
    )
    (command "mtext" tpt "j" "mc" "w" "0" lin "")
  ); repeat
)

The text are fields and will update if the objects are modified.

[marko_ribar]

I have created this code according to your request... It selects LWPOLYLINES and checks them for closed option (if not closed it closes them automatically), then it hatches them with default hatch and puts text with area number in center of polyline, for it previously create region from pline and obtains its centroid where it later puts area number...

(defun c:areahatchpolys ( / ss ssn k ent entA entarea entreg entregA cent)
(vl-load-com)
(prompt "\nSelect plines")
(setq ss (ssget (list (cons 0 "LWPOLYLINE"))))
(setq ssn (sslength ss))
(setq k -1)
(repeat ssn
(setq k (+ k 1))
(setq ent (ssname ss k))
(setq entA (vlax-ename->vla-object ent))
(setq entarea (vlax-get-Property entA 'Area))
(if (eq (vlax-get-Property entA 'Closed) :vlax-false) (vlax-put-Property entA 'Closed :vlax-true))
(vl-cmdf "region" ent "")
(setq entreg (entlast))
(setq entregA (vlax-ename->vla-object entreg))
(setq cent (vlax-safearray->list (vlax-variant-value (vlax-get-Property entregA 'Centroid))))
(vl-cmdf "_.explode" "l" "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.bhatch" "s" (entlast) "" "")
(vl-cmdf "_.text" cent "" "" entarea)
)
(princ)
)

M.R.
Hope this helps just for now...

[crbateman]

I have created this code according to your request... It selects LWPOLYLINES and checks them for closed option (if not closed it closes them automatically), then it hatches them with default hatch and puts text with area number in center of polyline, for it previously create region from pline and obtains its centroid where it later puts area number...

(defun c:areahatchpolys ( / ss ssn k ent entA entarea entreg entregA cent)
(vl-load-com)
(prompt "\nSelect plines")
(setq ss (ssget (list (cons 0 "LWPOLYLINE"))))
(setq ssn (sslength ss))
(setq k -1)
(repeat ssn
(setq k (+ k 1))
(setq ent (ssname ss k))
(setq entA (vlax-ename->vla-object ent))
(setq entarea (vlax-get-Property entA 'Area))
(if (eq (vlax-get-Property entA 'Closed) :vlax-false) (vlax-put-Property entA 'Closed :vlax-true))
(vl-cmdf "region" ent "")
(setq entreg (entlast))
(setq entregA (vlax-ename->vla-object entreg))
(setq cent (vlax-safearray->list (vlax-variant-value (vlax-get-Property entregA 'Centroid))))
(vl-cmdf "_.explode" "l" "")
(vl-cmdf "_.pedit" "l" "" "j" "p" "" "")
(vl-cmdf "_.bhatch" "s" (entlast) "" "")
(vl-cmdf "_.text" cent "" "" entarea)
)
(princ)
)

M.R.
Hope this helps just for now...

Marko, I've run into a couple of problems with this one. First, if run on 2008 (I have one machine that I use when on the road that only has that version) it bounces out with a "no database" error. Second, when run on a virgin install of 2011, there seems to be a hangup while hatching and inserting text for the area values. As the routine runs, the first region is hatched, but then the command line shows "Command:", and then the value for the area, and hangs up, as though it is trying to call a command, but the routine is returning a numerical value, instead of some command name. Then, if I click the left mouse button, the routine proceeds to the second pline entity, hatches it, and hangs up again with the area value for the new entity showing in the command line, etc. etc. etc... No text is inserted during this process (in case that helps you).

Maybe it's just a preference or some sysvar on my 2011 machine causing the problem, but it would also be really helpful if the routine would also run in 2008, as I cannot afford to upgrade that seat at the moment.

I very much like the thing you added to close an open polyline. I am pretty fastidious about closing them as I create the p-lines, but when doing hundreds at a time, it's inevitable that I may miss once in a while...

Thanks!

[marko_ribar]

Marko, I've run into a couple of problems with this one. First, if run on 2008 (I have one machine that I use when on the road that only has that version) it bounces out with a "no database" error. Second, when run on a virgin install of 2011, there seems to be a hangup while hatching and inserting text for the area values. As the routine runs, the first region is hatched, but then the command line shows "Command:", and then the value for the area, and hangs up, as though it is trying to call a command, but the routine is returning a numerical value, instead of some command name. Then, if I click the left mouse button, the routine proceeds to the second pline entity, hatches it, and hangs up again with the area value for the new entity showing in the command line, etc. etc. etc... No text is inserted during this process (in case that helps you).

Maybe it's just a preference or some sysvar on my 2011 machine causing the problem, but it would also be really helpful if the routine would also run in 2008, as I cannot afford to upgrade that seat at the moment.

I very much like the thing you added to close an open polyline. I am pretty fastidious about closing them as I create the p-lines, but when doing hundreds at a time, it's inevitable that I may miss once in a while...

Thanks!

Strange problem you have, I have ACAD 2008, ACAD 2011, ACAD 2012, ACA 2010, ACA 2012 (Windows 7 Ultimate X64), and on all of them it works... Perhaps your installation of ACADs wasn't complete (I had on my Toshiba Laptop earlier, ACAD 2006 installed without Vlisp Acivex support, and system on that laptop was old)... I thought it's ACAD 2006 that's bad, but it seems that it could be even ACAD 2008 and ACAD 2011 as you mentioned... I don't know what advice to tell you, but to check your installation again... Maybe it could also be hardware that's bad, but I doubt in this...

M.R.

BTW, maybe my SVF files for ACAD 2008, and ACAD 2011 will help you, and also I'll post lisp for comparing these SVF files... If you don't want to compare them, just save them and load mine, and if it works fine, but if not then revert your originals... Command is SYSVDLG...

[Opie]

You might try this. You may have to add (vl-load-com) before it works.

(defun c:AHP ( / findspace SPACE PLSelection CurrentSpace CurrentPattern cntPLSelection CurrentObject CurrentHatch)

  ;; Get current space                     
  ;; Function developed by Peter Jamtgaard  
  (defun FINDSPACE (/ *DOC*)
    (vl-load-com)
    (setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
    (setq SPACE	(if (= 1 (vla-get-activespace *DOC*))
		  (vla-get-modelspace *DOC*) ;we're in modelspace
		  (if (= (vla-get-mspace *DOC*) :vlax-true)
		    (vla-get-modelspace *DOC*) ;we're in modelspace
					;thru paperspace VPort
		    (vla-get-paperspace *DOC*) ;we're in paperspace
		  )
		)
    )
  )
  ;; Add field of area via MText
  ;; Partly taken from Tom Beauford
  ;; http://forums.augi.com/showpost.php?p=1120809&postcount=4
  (defun AddArea (Object	  /		  LowerLeftCorner
		  UpperRightCorner		  AreaString
		  FieldString	  PntList	  InsPoint
		  CurrentText
		 )
    (vla-getboundingbox
      Object
      'LowerLeftCorner
      'UpperRightCorner
    )
    (if	(vlax-property-available-p Object 'Area)
      (progn
	(setq FieldString (strcat
			    "%<\\AcObjProp Object(%<\\_ObjId "
			    (itoa (vla-get-objectid object))
			    ">%).Area \\f \"%lu2%pr0%qf1%ps[±, ft²]%th44\">%"
			  )		; 1=1 foot
	      PntList	  (mapcar 'vlax-safearray->list
				  (list LowerLeftCorner UpperRightCorner)
			  )
	      InsPoint	  (list	(/ (+ (caar PntList) (caadr PntList)) 2.0)
				(/ (+ (cadar PntList) (cadadr PntList)) 2.0)
			  )
	      CurrentText (vla-addmtext
			    (findspace)
			    (vlax-3d-point InsPoint)
			    0
			    FieldString
			  )
	)
      )
    )
  )
    
  ;; Main Function
  (if (progn
	(prompt "\nSelect polylines: ")
	(setq PLSelection    (ssget '((0 . "LWPOLYLINE,POLYLINE") (70 . 1)))
	      CurrentSpace   (findspace)
	      CurrentPattern (getvar 'HPNAME)
	)
      )
    (progn
      (repeat (setq cntPLSelection (sslength PLSelection))
	(setq CurrentObject (vlax-ename->vla-object
			      (ssname
				PLSelection
				(setq cntPLSelection (1- cntPLSelection))
			      )
			    )
	      CurrentArea   (vla-get-area CurrentObject)
	)
	(setq CurrentHatch
	       (vla-addhatch
		 CurrentSpace		  acHatchPatternTypePredefined
		 CurrentPattern		  :vlax-true
		 AcHatchObject
		)
	)
	(vla-appendouterloop
	  CurrentHatch
	  (vlax-safearray-fill
	    (vlax-make-safearray vlax-vbobject '(0 . 0))
	    (list CurrentObject)
	  )
	)
	(vla-put-PatternScale CurrentHatch (getvar 'HPSCALE))
	(AddArea CurrentObject)
      )
    )
  )
)

[crbateman]

You might try this. You may have to add (vl-load-com) before it works.

Seems to work fine, Opie (in both 2008 and 2011). Thanks!

[Opie]

Seems to work fine, Opie (in both 2008 and 2011). Thanks!

You will need to set either the TEXTSIZE system variable to your desired size beforehand or add an option to specify the text size. I figured you could add that enhancement with your previous knowledge.

Hopefully this will get you back into AutoLISP a bit more. Enjoy.