LISP - inserting polygon objects into a table

LISP - inserting polygon objects into a table

Anonymous
Not applicable
1,026 Views
1 Reply
Message 1 of 2

LISP - inserting polygon objects into a table

Anonymous
Not applicable

Hi everyone. I'm stumbling into learning Lisp.

I found the lisp below, which does just about what I want it do. The only thing that is missing is that if you modify
the room labels or size and do a RegenAll, the table doesn't update.

I think you should be able to do this by inserting fields into the table, but I can't quite get it to work.
I know there is an object in the lisp, and I can get the object ID, but still can't get the whole thing to work.

In my mind, I think this type of command should work (but it obviously isn't)

(vla-settext table 1 1
(strcat((
"%<\\AcObjProp Object(%<\\_ObjId" itoa (vla-get-Objectid vlpobj) ">%).Area \\f "%lu2">%" ))))

Any help or suggestions would be greatly appreciated.

The working lisp is below

(defun Poly-Pts (pl / pa pt lst)
(vl-load-com)
(setq pa (if (vlax-curve-IsClosed pl)
(vlax-curve-getEndParam pl)
(+ (vlax-curve-getEndParam pl) 1)
)
)
(while (setq pt (vlax-curve-getPointAtParam pl (setq pa (- pa 1))))
(setq lst (cons pt lst))
)
)
(defun c:RoomArea ( / AllSlctn pobj pobjArea pobjPoints LineText LineTextObj pnt loc cnt objID)
(setq AllSlctn (ssget '((0 . "LWPOLYLINE"))))
(if AllSlctn
(progn
(setq pnt (getpoint "\nPick the point for table: "))
(setq loc (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))))
(setq table (vla-AddTable loc (vlax-3d-point pnt) 2 2 1 5))
(vla-settext table 0 0 "Area Table")
(vla-settext table 1 0 "Line Name")
(vla-settext table 1 1 "Area")

(setq cnt 0)
(repeat (sslength AllSlctn)
(setq pobj (ssname AllSlctn cnt))
(setq vlpobj (vlax-ename->vla-object pobj))
(setq pobjArea (vla-get-area vlpobj))

(setq pobjPoints (Poly-Pts pobj))

(setq LineTextObj (ssget "_WP" pobjPoints '((0 . "*TEXT"))))
(if LineTextObj
(progn
(setq LineText (vlax-ename->vla-object(ssname LineTextObj 0 )))
(vla-insertrows table (+ 2 cnt) 1 1)
(vla-settext table (+ 2 cnt) 0 (vla-get-TextString LineText))
(vla-settext table (+ 2 cnt) 1 (strcat(rtos (/(vla-get-area vlpobj)) 2 2)))


);progn
);if
(setq cnt ( + cnt 1))
);repeat

(vla-insertrows table (+ 2 cnt) 1 1)

(vla-setText table
(+ 2 cnt)
1
(strcat

"Total Area =\\P"
"%<\\AcExpr (Sum(B3:B" (itoa (+ 2 cnt)) ")) \\f \"%lu2\">%"


) ;; end strcat
) ;; end vla

);progn
);if
);defun

0 Likes
Accepted solutions (1)
1,027 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
Accepted solution

I found where I went wrong.  

 

The command I got to work looks something like this....

 

(vla-settext table (+ 2 cnt) 1 (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       ( strcat(itoa (vla-get-Objectid vlpobj) )) ">%).Area \\f \"%lu2%pr2\">%"))

0 Likes