AUTOLISP FIELD AREA FOR PL BUG

[Gabriel Paixão]

I am trying to adapt an AutoLISP that automates the creation of fields linked to polyline areas. My goal is that based on a layer pre-established by the user, the program creates an MTEXT with a field linked to the area at its center for all closed polylines.

Código original: 

 

My adapt:
 

 

(defun c:A2FL ( / *error* fmt targetLayer allPolylines filteredSel
                 idx ename obj str minPt maxPt minX minY maxX maxY centerPnt
              )

    ;; Define the default formatting string for the Field.
    ;; "%lu6%qf1" generally means length units with 6 decimal places and zero suppression.
    ;; You can adjust this according to your needs (e.g., "%lu2%qf1" for 2 decimal places).
    (setq fmt "%lu6%qf1")

    ;; --- Local Error Handler for A2FL Command ---
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc)) ;; Ensures that the UNDO group is closed
        (if (not (wcmatch (strcase msg T) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg)) ;; Displays the error message (unless it's a user interruption)
        )
        (princ) ;; Suppresses the output of the last evaluated value
    )

    (princ "\n--- Command: A2FL (Individual Polyline Areas by Layer) ---")

    ;; --- Step 1: Request Target Layer Name from User ---
    (setq targetLayer (getstring T "\nPlease enter the layer name for closed polylines: "))

    ;; Check if the layer name was provided.
    (if (= "" targetLayer)
        (progn
            (princ "\nLayer name cannot be empty. Exiting 'A2FL'.")
            (exit) ;; Aborts command execution
        )
    )
    ;; Convert the layer name to uppercase to ensure case-insensitive comparison.
    (setq targetLayer (strcase targetLayer))

    ;; --- Step 2: Automatically Select and Filter Closed Polylines in Target Layer ---
    ;; 'ssget "_X"' selects all entities in the drawing.
    ;; The filter '((0 . "*POLYLINE"))' restricts the initial selection to polylines only (2D, 3D and Lightweight).
    (setq allPolylines (ssget "_X" '((0 . "*POLYLINE"))))

    ;; Initialize an empty selection set to store only the filtered polylines.
    (setq filteredSel (ssadd))

    ;; If there are polylines in the drawing to check:
    (if allPolylines
        (progn
            ;; Iterate over each polyline in the 'allPolylines' selection.
            (repeat (setq idx (sslength allPolylines))
                (setq ename (ssname allPolylines (setq idx (1- idx)))) ;; Get the entity name
                (setq obj (vlax-ename->vla-object ename)) ;; Convert entity name to VLA object

                ;; Check if the polyline is in the target layer AND if it is closed.
                (if (and (= (strcase (vla-get-layer obj)) targetLayer)
                         (eq :vlax-true (vla-get-closed obj))
                    )
                    (ssadd ename filteredSel) ;; Add the polyline to our filtered selection set
                )
            )
        )
    )

    ;; --- Step 3: Check if Any Suitable Polyline Was Found ---
    ;; If the 'filteredSel' selection set is empty after filtering:
    (if (zerop (sslength filteredSel))
        (progn
            (princ (strcat "\nNo closed polylines found in layer '" targetLayer "'. Exiting 'A2FL'."))
            (exit) ;; Aborts command execution
        )
    )

    (LM:startundo (LM:acdoc)) ;; Start an UNDO group so all operations can be easily undone.

    ;; --- Step 4: Process Each Filtered Polyline ---
    (repeat (setq idx (sslength filteredSel))
        (setq ename (ssname filteredSel (setq idx (1- idx)))) ;; Get the entity name of current polyline
        (setq obj (vlax-ename->vla-object ename))             ;; Convert to VLA object

        ;; --- 4.1: Calculate the Central Point (approximate) for MText ---
        ;; We use the bounding box of the polyline to find an approximate center.
        ;; For complex or concave polylines, this point may not be "inside" the geometry,
        ;; but it's a simple and generally effective method for text placement.
        (vla-GetBoundingBox obj 'minPt 'maxPt) ;; Get the minimum and maximum corners of the bounding box
        (setq minX (vlax-safearray-get-element minPt 0)
              minY (vlax-safearray-get-element minPt 1)
              maxX (vlax-safearray-get-element maxPt 0)
              maxY (vlax-safearray-get-element maxPt 1)
        )
        ;; Calculate the midpoint of the bounding box.
        (setq centerPnt (list (/ (+ minX maxX) 2.0) (/ (+ minY maxY) 2.0) 0.0)) ;; Z always 0 for 2D

        ;; --- 4.2: Build the Field Expression String for Current Polyline ---
        ;; This string is the same used for a single object in the original 'A2F' command,
        ;; ensuring correct field interpretation by AutoCAD.
        (setq str
            (strcat
                "%<\AcObjProp Object(%<_ObjId "
                (LM:ObjectID obj) ;; Use the ID of the *current* polyline
                ">%).Area \f "" fmt "">%"
            )
        )

        ;; --- 4.3: Create and Insert the MText Object in the Drawing ---
        ;; The MText is always added to Modelspace in this command, at the calculated center point.
        (vla-addmtext
            (vlax-get-property (LM:acdoc) 'modelspace) ;; Add to Modelspace
            (vlax-3D-point centerPnt)                 ;; Insertion point (the centroid)
            0.0                                       ;; Text height (uses default height or annotative scale)
            str                                       ;; The generated field string
        )
    )

    (LM:endundo (LM:acdoc)) ;; End the UNDO group.
    (princ (strcat "\nCommand 'A2FL' completed. " (itoa (sslength filteredSel)) " area fields inserted."))
    (princ) ;; Suppress the output of the last evaluated value in the command line.
)

;; The auxiliary functions (LM:ObjectID, LM:getcell, LM:startundo, LM:endundo, LM:acdoc)
;; and COM loading (vl-load-com) (princ) are assumed to be already defined
;; and available in your original 'Areas2FieldV1-3.txt' file.
;; Do not redefine them here if they are already in the same file.

 

Edited 12 hours ago by CADTutor
Add code block

[Steven P]

If it was me I would allow the user to select an entity on the layer rather than typing it in, or use something like BigAls multi getvals to select the layer from a list - saves typing errors.

 

You can add to filters in the selection set:

 

(setq allPolylines (ssget "_X" (list (0 . "*POLYLINE")(cons 8 MyLayerName))))

 

Note here that list is used if you want any of the filters to be programmatically. 'cons' used to construct the list and MyLayerName is a variable you might want to work out earlier in the LISP. Lee Mac has a very good explanation on his website for ssget.

 

You can loop through your selection set and perhaps this snippet will help:

 

;;https://www.cadtutor.net/forum/topic/66091-centre-of-hatch/
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:CtrCoo (/ findctr a apt) ;;Center point of a hatch or a rectangle
  (defun findctr (en / pt)
    (command "_.Zoom" "_Object" en "")
    (setq pt (getvar 'viewctr))
    (command "_.Zoom" "_Previous")
    pt
  )
  (setq a (car (entsel "Select Rectangle: : "))
        apt (findctr a)
  )
  (command "_Text" "_Justify" "_MC" apt 0.1 0 apt)
  (princ)
  )

 

 

Copy FindCtr and use that to get the centre point of each object, using that as the insert point for the mtext.

 

 

Maybe this will help you along?

[BIGAL]

Also this as mentioned.

 

(setq ent (entget (car (entsel "\nPick an object for layer name "))))
(setq MyLayerName (cdr (assoc 8 ent)))
(setq allPolylines (ssget "_X" (list (0 . "*POLYLINE")(cons 8 MyLayerName))))