
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.