Topic: Help with area lisp

[Jimmy Sean]

I have this lisp routine that our engineers use.  I have tweaked it in the past but I cannot identify why it fails now.  I would be grateful if someone with more skill than I have help me to identify the issue and how to correct it.  The routine should allow a selection of a polyline and then placement of mtext field that shows the square footage.  it fails after the selection point for the placement of the field.  It doesn't error but it doesn't show the text either.

Code: [Select]

(defun c:arl64 ()
(vl-load-com)
;;get a reference to model space
(setvar "textsize" 0.09375)
(setvar "luprec" 0)
(setq *model-space*
       (vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
       )
)
;;pass this function an entity and a point
(defun LinkedArea (ent pt / obj objID ip width str)
  ;;convert the entity to an object
  (setq ar2 (car (entsel "\nSelect Area Boundary: ")))
  (setq objID (vlax-invoke-method (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))) "GetObjectIdString" (vlax-ename->vla-object ar2) :vlax-False))

  (setq ;;convert the point
ip    (vlax-3D-Point pt)
;;set the width for the MTEXT
width 0.0
  )
;;set the string - this creates the field
  (setq str (strcat "%<\\AcObjProp Object(%<\\_ObjId " objID ">%).Area \\f \"%pr0%lu2%ct4%qf1 SQ. FT.\">%"))

  ;;Create the MTEXT entity containing the field.
  (vla-addMText *model-space* ip width str)
)

;; Set A = the entity and set B = Point for text
(setq a (car (entsel)) b (getpoint "\n Select Text Insertion Point: "))
;;Call the function
(linkedarea a b)
(princ)
  )s
Thanks,
Sean

[ronjonp]

Here's a quick write up. Make sure you locali(sz)e variables and if you change a system variable it should be set back to it's original value after your code runs.

Code: [Select]


(defun c:arl64 (/ a b lu objid ts)
  (vl-load-com)
  (if (and (setq a (car (entsel "\nSelect Area Boundary: ")))
   (setq b (getpoint "\n Select Text Insertion Point: "))
      )
    (progn (setq ts (getvar 'textsize))
   (setq lu (getvar 'luprec))
   (setvar 'textsize 0.09375)
   (setvar 'luprec 0)
   (setq objid (vla-get-objectid (vlax-ename->vla-object a)))
   (vla-addmtext
     (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
     (vlax-3d-point (trans b 1 0))
     0.0
     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
     (itoa objid)
     ">%).Area \\f \"%pr0%lu2%ct4%qf1 SQ. FT.\">%"
     )
   )
   ;; reset variables
   (setvar 'textsize ts)
   (setvar 'luprec lu)
    )
  )
  (princ)
)


[CAB]

I think I would take it a step further with some more error checking.

Code - Auto/Visual Lisp: [Select]

1. (defun c:arl64 (/ ent pt obj)
2.   (vl-load-com)
3.   (cond
4.     ((null(setq ent (car (entsel "\nSelect Area Boundary: "))))
5.      (princ "\nMissed Pick."))
6.     ((and (setq obj (vlax-ename->vla-object ent))
7.           (not (vlax-property-available-p obj 'area)))
8.      (princ "\nNo Area for that object."))
9.     ((null (setq pt (getpoint "\n Select Text Insertion Point: ")))
10.      (princ "\nUser Quit."))
11.     (t
12.      (setq obj (vla-addmtext
13.          (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
14.          (vlax-3d-point (trans pt 1 0))
15.          0.0
16.          (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid  obj))
17.                      ">%).Area \\f \"%pr0%lu2%ct4%qf1 SQ. FT.\">%")
18.        ))
19.            (and obj (vla-put-height obj 0.09375))
20.     )
21.   )
22.   (princ)
23. )

[ronjonp]

Way to cleanup my mess CAB

[Lee Mac]

FWIW, here is how I might code it to include support for both 32-bit & 64-bit systems:

Code - Auto/Visual Lisp: [Select]

1. (defun c:arl64 ( / ins obj )
2.     (while
3.         (progn (setvar 'errno 0) (setq obj (car (entsel "\nSelect Area Boundary: ")))
4.             (cond
5.                 (   (= 7 (getvar 'errno))
6.                     (princ "\nMissed, try again.")
7.                 )
8.                 (   (/= 'ename (type obj))
9.                     nil
10.                 )
11.                 (   (not (vlax-property-available-p (setq obj (vlax-ename->vla-object obj)) 'area))
12.                     (princ "\nSelected object does not define an area.")
13.                 )
14.                 (   (setq ins (getpoint "\nSpecify Point for Field: "))
15.                     (vla-put-height
16.                         (vla-addmtext
17.                             (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
18.                             (vlax-3D-point (trans ins 1 0))
19.                             0.0
20.                             (strcat
21.                                 "%<\\AcObjProp Object(%<\\_ObjId "
22.                                 (LM:ObjectID obj)
23.                                 ">%).Area \\f \"%pr0%lu2%ct4%qf1 SQ. FT.\">%"
24.                             )
25.                         )
26.                         0.09375
27.                     )
28.                 )
29.             )
30.         )
31.     )
32.     (princ)
33. )
34.  
35. ;; ObjectID  -  Lee Mac
36. ;; Returns a string containing the ObjectID of a supplied VLA-Object
37. ;; Compatible with 32-bit & 64-bit systems
38.  
39. (defun LM:ObjectID ( obj )
40.     (eval
41.         (list 'defun 'LM:ObjectID '( obj )
42.             (if
43.                 (and
44.                     (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
45.                     (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
46.                 )
47.                 (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
48.                '(itoa (vla-get-objectid obj))
49.             )
50.         )
51.     )
52.     (LM:ObjectID obj)
53. )
54.  
55. ;; Active Document  -  Lee Mac
56. ;; Returns the VLA Active Document Object
57.  
58. (defun LM:acdoc nil
59.     (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
60.     (LM:acdoc)
61. )
62.  
63. (vl-load-com) (princ)

You might also be interested in my Areas to Field program - simply change the field formatting at the top of the program to:

Code - Auto/Visual Lisp: [Select]

1. "%pr0%lu2%ct4%qf1 SQ. FT."