Offset object based on percentage of area

[Bill_Myron]

Have looked high and low for something that can accomplish a task we have recently been required to do.

Essentially a closed polyline needs to be offset a distance that the resultant area is a certain (User defined) percentage of the original object area. Understanding that this a fairly iterative process depending on the shape of the object.

We can get the resulting area by using SCALE, but the object produced is fairly distorted.

I'm hoping someone has a good option or idea for this. Thanks!

[BIGAL]

If you look at Vlax-get obj 'area it will return an area so you can compare that answer is it within tolerance for the new object just added. yes you must use a iterative approach, either using a small offset repeatedly till you get to the desired result may use a seed starting value. Then just keep adding to offset value, it can be slow. An alternative method is to jump to halves, you purposely oversize the offset 1st guess, check is equal then jump to a 1/2 way of 1/2 way value if smaller jump to new 1/2 way + 1/2 way of old outside value, hopefully this makes sense see diagram. You are resetting offset step value each time by 1/2.

 

When used as a search a sorted values say 10,000 it takes 13 goes to find the item your looking for, that is fast.

 

How much do you know about lisp ?

 

Something to have a play with. I have set a limit so stops endless loop.

 

(defun c:wow ( / area% oldsnap obj area1 area2 x)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(setq plent (car (entsel "\nPick object ")))
(setq obj (vlax-ename->vla-object plent ))
(setq area1 (vlax-get obj 'area))
(setq area% (* area1 (+ 1.0 (/ (getreal "\nEnter % ") 100.))))
(setq off 0.0 step 0.0001 x 1)
(repeat 3000
  (vla-offset obj (setq off (+ off step)))
  (setq area2 (vlax-get (vlax-ename->vla-object (entlast)) 'area))
  (princ (setq x (1+ x)))
  (if (equal area2 area% 0.01)
  (progn (alert (strcat "\nArea found  " (rtos area% 2 3) "  " (rtos area2 2 3) ))(exit))
  )
  (vla-delete (vlax-ename->vla-object (entlast)))
)
(setvar 'osmode oldsnap)
(if (> x 3000) (alert "solution not found "))
(princ)
)
(c:wow)

 

Edited December 6 by BIGAL

[Bill_Myron]

Sorry, took some time to get back to this. 
Only got a basic info on LISP.  Nothing of this nature anyway.

I think the fastest way to achieve this is the offset by 1/2. Check the area and then apply the offset directed inside or outside.

Cant lie, ran this through AI a bunch of times to get something that functions. Only issue is if the offset value is greater than a pinch point in the object that results in two objects created. Gets a little wild after that.

 

If you notice anything somewhat wrong or problematic let me know.

Thanks for setting me in the correct direction. 

 

(defun c:OO ( / area% oldsnap obj original-area current-area offset cumulative-offset iterations tol original-entity final-offset-entity counter target-area original-area-ha final-area-ha target-area-ha)

  (vl-load-com)

  (setq oldsnap (getvar 'osmode))  ;; Save the current object snap mode
  (setvar 'osmode 0)               ;; Disable object snap
  (setvar 'cmdecho 0)              ;; Suppress command echo
  
  ;; Prompt the user to select an object
  (if (setq original-entity (car (entsel "\nPick object: ")))
    (progn
      ;; Get the object as a VLA object and retrieve its area
      (setq obj (vlax-ename->vla-object original-entity))
      (setq original-area (vlax-get obj 'area))
      
      ;; Prompt the user to enter the target percentage of the original area
      (setq area% (getreal "\nEnter target % of the original area: "))
      
      ;; Calculate the target area based on the percentage input
      (setq target-area (* original-area (/ area% 100.0)))
      
      ;; Set the initial offset based on area%
      (setq offset (getreal "\nEnter the initial offset value: "))
      
      ;; Adjust the initial offset based on area%
      (if (< area% 100)
          (setq offset (* -1 offset))  ;; Make offset negative if area% is less than 100%
          (setq offset (* 1 offset)))  ;; Keep offset positive if area% is greater than or equal to 100%
      
      ;; Test initial offset before proceeding
      (if (not (vl-catch-all-error-p
                 (setq error-result
                       (vl-catch-all-apply
                         (function vla-offset)
                         (list (vlax-ename->vla-object original-entity) offset)))))
        (progn
          ;; Remove the entity created during the initial test
          (if (entlast)
            (vla-delete (vlax-ename->vla-object (entlast))))

          ;; Initialize variables
          (setq cumulative-offset 0.0        ;; Track the cumulative offset
                iterations 20                ;; Number of iterations
                tol 0.0001                   ;; Tolerance for area matching
                current-area original-area                   ;; Initialize current area as the original area
                counter 1)                    ;; Initialize the counter to 1
          
          ;; Iterate to find the target area
          (repeat iterations
            ;; Apply an offset based on the cumulative offset value
            (vla-offset (vlax-ename->vla-object original-entity) (+ cumulative-offset offset))
            (setq cumulative-offset (+ cumulative-offset offset)) ;; Update cumulative offset
            (setq current-area (vlax-get (vlax-ename->vla-object (entlast)) 'area)) ;; Get the new area
            
            ;; Display progress in the command line with the iteration counter
            (princ (strcat 
                           "\nIteration: " (if (< counter 10) (strcat "0" (itoa counter)) (itoa counter))
                           " | Offset: " (rtos (abs cumulative-offset) 2 8)
                           " | Area: " (rtos current-area 2 3) "m\U+00B2"))
        
            ;; Adjust the offset dynamically based on target area
            (if (> current-area target-area) ; If the current area is larger than the target
              (setq offset (/ (abs offset) -2))  ;; Offset inward (negative)
              (setq offset (/ (abs offset) 2)))  ;; Offset outward (positive)
            
            ;; Clean up the last offset entity (to ensure only final offset remains)
            (vla-delete (vlax-ename->vla-object (entlast)))
            
            ;; Increment the counter
            (setq counter (+ counter 1))
          )
          
          ;; Apply the final cumulative offset to the original entity and retain it
          (vla-offset (vlax-ename->vla-object original-entity) cumulative-offset)
          (setq final-offset-entity (entlast))
          
          ;; Convert the final area to hectares
          (setq original-area-ha (/ original-area 10000.0))  ;; Convert square meters to hectares
          (setq final-area-ha (/ current-area 10000.0)) ;; Convert final area to hectares
          (setq target-area-ha (/ target-area 10000.0)) ;; Convert target area to hectares
          
          ;; Display results with proper alignment
          (princ (strcat 
            "\nFinal Offset Applied!"
            "\nOriginal Area:       " (rtos original-area 2 0) "m\U+00B2 / " (rtos original-area-ha 2 3) "ha"
            "\nTarget Area (" (rtos area% 2 0) "%):   " (rtos target-area 2 0) "m\U+00B2 / " (rtos target-area-ha 2 3) "ha"
            "\nFinal Area:          " (rtos current-area 2 0) "m\U+00B2 / " (rtos final-area-ha 2 3) "ha"
            "\nFinal Offset:        " (rtos (abs cumulative-offset) 2 3)
            "\nResulting Entity Retained.")))
        ;; If the initial offset fails, notify the user
        (princ "\nError: The selected object does not support offset. Operation terminated."))
    )
    ;; Notify the user if no object is selected
    (princ "\nNo object selected!"))
  
  ;; Restore the original object snap mode
  (setvar 'osmode oldsnap)

  (princ)
)

 

Edited December 11 by Bill_Myron

[BIGAL]

I think you need another (if (equal current-area target-area 0.00001) drop out of loop) as the CAD works at like 14 figures it will always return a < or > value so never exit out of a loop or just to repeat number.