Topic: Help with this lisp (text with Hatch area)

[HasanCAD]

I am trying to code a lisp tp inset a text with Hach area
but not working

Code: [Select]

(defun c:HatchArea ()
  (vl-load-com)

  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  (vla-EndUndoMark ActDoc)
  (vla-StartUndoMark ActDoc)

  (while T
    (and
      (setq objlst (ssget '((-4 . "<OR")(0 . "HATCH")(-4 . "OR>"))))
      (setq objent (ssname objlst 0));;grab ename
      (setq Pnt0 (trans (getpoint "\nInsertion point")1 0))
      )
    (progn
      (command "area" "o" objlst)
      (setq aaa (itoa (vla-get-objectid objlst)))
      (setq H-Area (strcat
    "%<\AcObjProp Object(%<\_ObjId "
    (itoa (vla-get-objectid objlst))
    ">%).Area \f " "%lu2%pr2" ">%" ))  

    (entmakex (list
(cons 0  "TEXT")
       (cons 1  H-Area)
       (cons 10 Pnt0)
       (cons 40 220)
       (cons 41 0.8)
))
      )
    )
  (vla-EndUndoMark ActDoc)
  
  (princ "\n  ...Type HATCHAREA to Invoke...")
  (princ)
  )
[edit:kdub Title Revised]

[Lee Mac]

Entmake'ing Fields is pretty difficult, as you have to also entmake the extension dictionary of the text, mtext or attribute and then the ACAD_FIELD dictionary stored within that and the TEXT dictionary stored within that...

Hence the workaround is to use vla-AddMText/AddText to create the MText/Text Field.

[HasanCAD]

I used area as a text instead of field
but not working

gives an error

Code: [Select]

Command: ; error: bad argument type: VLA-OBJECT <Entity name: 7d997e38>
The code

Code: [Select]

(defun c:HatchArea ()
  (vl-load-com)

  (setq AcObj (vlax-get-Acad-Object))
  (setq ActDoc (vla-get-ActiveDocument AcObj))
  (vla-EndUndoMark ActDoc)
  (vla-StartUndoMark ActDoc)

  (while T
    (and
      (setq objlst (ssget '((-4 . "<OR")(0 . "HATCH")(-4 . "OR>"))))
      (setq objent (ssname objlst 0));;grab ename
      (setq Pnt0 (trans (getpoint "\nInsertion point")1 0))
      )
    (progn
      (command "area" "o" objent)
      (setq H-Area (itoa (getvar "area"))) 

    (entmakex (list
(cons 0  "TEXT")
        (cons 1  H-Area)
        (cons 10 Pnt0)
        (cons 40 220)
        (cons 41 0.8)
))
      )
    )
  (vla-EndUndoMark ActDoc)
 
  (princ "\n  HATCHAREA.lsp ~ Copyright © by HasanCAD")
  (princ "\n  ...Type HATCHAREA to Invoke...")
  (princ)
  )

[CAB]

You may get some help by looking at this  lisp.
http://www.theswamp.org/index.php?topic=1303.0

Note that a hatch without an associative border does not have an area!

[huiz]

...

Note that a hatch without an associative border does not have an area!

That is not true. Only hatches that are incorrect (like crossing vertices or a vertex with a length of zero) don't have an area property. Non-associative blocks that are correct do have an area property.




Here is some code wich creates a field with the area of a polyline:

  (setq ar1 (entsel "\nSelect closed polyline: "))
  (setq ar2 (car ar1))
  (setq tab (vlax-ename->vla-object ar2))
  (setq oba (vla-get-objectid tab))
  (setq myarea (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, m²]\">%"))

Myarea is a string containing a field. You can put that as text object or use in a block attribute.

[CAB]

Sorry I miss remembered. And in my ACAD2000 there is no area property for a hatch. Not sure which ACAD version it started.

This is from another thread.

[T.Willey]

You can use this code to make the field information once the the text entity is created.

[ http://www.theswamp.org/index.php?topic=20446.0 ]

[Lee Mac]

Perhaps this will point you in the right direction Hasan:

Code: [Select]

(defun c:ObjectArea ( / doc spc ent obj pt )
  (vl-load-com)

  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
        spc (vlax-get doc (if (= 1 (getvar 'CVPORT)) 'PaperSpace 'ModelSpace)))

  (while (setq ent (car (entsel "\nSelect Object <Exit> : ")))

    (if (vlax-property-available-p (setq obj (vlax-ename->vla-object ent)) 'Area)

      (if (setq pt (getpoint "\nSpecify Point for Field: "))
        (vla-put-ScaleFactor
          (vla-AddText spc
            (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj)) ">%).Area \\f \"%lu2%pr2\">%")
            (vlax-3D-point (trans pt 1 0))
            220.0
          )
          0.8
        )
      )
     
      (princ "\n** Object Must have an Area Property **")
    )
  )

  (princ)
)
A few things to note:

• Don't use (While T ...), this forces the user to hit Esc to exit, and hence throws an error - instead, use a statement which may evaluate to nil upon the user not doing/picking/meeting some condition
• Use a VL method when adding Fields, it is far easier than entmake'ing all the dictionaries (see Tim's link for the alternative)
• Remember to use "\" to prefix backslashes and quotation marks in the FieldString, hence \ becomes \\ and " becomes \"
• Test for valid data before using functions that will throw an error if not supplied with a valid argument, example: (trans nil 1 0) will error.
• Be sure you are supplying functions with the correct data type, for example, in your code: (vla-get-objectid objlst) will fail, as 'objlst' is a SelectionSet. Furthermore, name your variables more relevantly, hence in this example, instead of 'objlst' perhaps use 'selset' or 'ss'.

[CAB]

One caution, the property can be available but nil.
If I remember correctly. No time to check it now.

Later.

[HasanCAD]

Thanks all
I am going to study all of that