Topic: Why does LWpolyline not work on this routine

[Biscuits]

Using Acad 2010.
This routine works fine on regular polylines for getting perimeter, area, weight, etc.......but fails on lwpolylines.
Any ideas how to correct this?

Thanks

Code: [Select]

; WLA.LSP


(defun C:wla (/ HA HP THA THP LTHA LTHP PA PP TPA TPP GA W CIR SSL NSSET TEMP CTR ENT)

(setvar "cmdecho" 0)

; Isolates the DWG layer
  (princ)
  (command "layer" "off" "*" "y" "")
; (command "layer" "on" "dwg" "")
  (command "layer" "on" "cnc" "")

; The following clears all previous variables

(setq HA 0.00)     ; Hole area
(setq HP 0.00)     ; Hole perimeter
(setq THA 0.00)   ; Total hole area
(setq THP 0.00)   ; Total hole perimeter
(setq LTHA 0.00)   ; Total hole area
(setq LTHP 0.00)   ; Total hole perimeter
(setq PA 0.00)     ; Part area
(setq PP 0.00)     ; Part perimeter
(setq TPA 0.00)   ; Total part area
(setq TPP 0.00)   ; Total part perimeter
(setq GA 0.00)     ; Gauge of the part
(setq W 0.00)      ; Weight of the part

; Gets the parts area and perimeter

    (princ "\n\n SELECT PART: ")
    (command "area" "o" pause)
  (setq PA (getvar "area"))
  (setq PP (getvar "perimeter"))



; Selects the holes in the part and calculates the area and perimeter

  (prompt "\n\n SELECT ALL HOLES ON THE PART:")
  (setq CIR (ssget))

 (if CIR
 (progn
  (setq SSL   (sslength CIR)
        NSSET (ssadd)
  ) ;_ end of setq

  (while (> SSL 0.00)
    (setq TEMP (ssname CIR (setq SSL (1- SSL))))
      (ssadd TEMP NSSET)
  ) ;_ end of while

  (setq SSL (sslength NSSET)
        CIR NSSET
  ) ;_ end of setq

  (setq CTR 0)

  (while
    (setq ENT (ssname CIR CTR))
      (command "area" "o" ENT)
    (setq HA (getvar "area"))
    (setq HP (getvar "perimeter"))
     (setq THA (+ THA HA))
     (setq THP (+ THP HP))
     (setq CTR (+ 1 CTR))
  ) ;_ end of while

 (princ"   Done...  ")) ;_end of progn
(princ"    Nothing selected.  ")) ;_end of if

---------------------------------------------------------------------------------------------------------------------------

  (prompt "\n\n SELECT ALL LASER TEXT ON THE PART:")
  (setq CIR (ssget))

 (if CIR
 (progn
  (setq LSSL   (sslength CIR)
        NSSET (ssadd)
  ) ;_ end of setq

  (while (> LSSL 0.00)
    (setq TEMP (ssname CIR (setq LSSL (1- LSSL))))
      (ssadd TEMP NSSET)
  ) ;_ end of while

  (setq LSSL (sslength NSSET)
        CIR NSSET
  ) ;_ end of setq

  (setq CTR 0)

  (while
    (setq ENT (ssname CIR CTR))
      (command "area" "o" ENT)
    (setq HA (getvar "area"))
    (setq HP (getvar "perimeter"))
     (setq LTHA (+ LTHA HA))
     (setq LTHP (+ LTHP HP))
     (setq CTR (+ 1 CTR))
  ) ;_ end of while

 (princ"   Done...  ")) ;_end of progn
(princ"    Nothing selected.  ")) ;_end of if

  (princ)
     (print LSSL)
     (princ "Laser Text Entities Found. ")
  (princ)

;---------------------------------------------------------------------------------------------------------------------------
; The following takes the total hole area and subtracts from the part area then
; calculates the total part area. Also takes the total hole perimeter and adds to
; the part perimeter then calculates the total part perimeter.

  (setq TPA (- PA THA))
  (setq TPP (+ PP THP LTHP))


; Turns all the layers back on

  (command "layer" "on" "*" "")
  (command "layer" "u" "*" "")
  (command "layer" "t" "*" "")


; The following gets the gauge of the part and sets it to decimal thickness

    (initget (+ 1 2 4))
    (setq GA (getint "\n\n WHAT IS THE GAUGE OF THE PART?: "))

                 (IF
                  (= GA 3)
                  (setq GA 0.2391)
                  (setq GA GA)
                 )
                 (IF
                  (= GA 4)
                  (setq GA 0.2242)
                 (setq GA GA)
                )
                (IF
                  (= GA 5)
                  (setq GA 0.2092)
                  (setq GA GA)
                )
                (IF
                  (= GA 6)
                  (setq GA 0.1943)
                  (setq GA GA)
                )
                (IF
                  (= GA 7)
                  (setq GA 0.1793)
                  (setq GA GA)
                )
                (IF
                  (= GA 8)
                  (setq GA 0.1644)
                  (setq GA GA)
                )
                (IF
                  (= GA 9)
                  (setq GA 0.1495)
                  (setq GA GA)
                )
;;;;;;;;;;;;;;;;;
                 (IF
                  (= GA 10)
                  (setq GA 0.1345)
                  (setq GA GA)
                 )
                 (IF
                  (= GA 11)
                  (setq GA 0.1186)
                 (setq GA GA)
                )
                (IF
                  (= GA 12)
                  (setq GA 0.1065)
                  (setq GA GA)
                )
                (IF
                  (= GA 13)
                  (setq GA 0.0900)
                  (setq GA GA)
                )
                (IF
                  (= GA 14)
                  (setq GA 0.0770)
                  (setq GA GA)
                )
                (IF
                  (= GA 15)
                  (setq GA 0.0673)
                  (setq GA GA)
                )
                (IF
                  (= GA 16)
                  (setq GA 0.0570)
                  (setq GA GA)
                )
                (IF
                  (= GA 17)
                  (setq GA 0.0538)
                  (setq GA GA)
                )
                (IF
                  (= GA 18)
                  (setq GA 0.0470)
                  (setq GA GA)
                )
                (IF
                  (= GA 19)
                  (setq GA 0.0395)
                  (setq GA GA)
                )
                (IF
                  (= GA 20)
                  (setq GA 0.0359)
                  (setq GA GA)
                )
                (IF
                  (= GA 21)
                  (setq GA 0.0329)
                  (setq GA GA)
                )
                (IF
                  (= GA 22)
                  (setq GA 0.0280)
                  (setq GA GA)
                )
                (IF
                  (= GA 23)
                  (setq GA 0.0269)
                  (setq GA GA)
                )
                (IF
                  (= GA 24)
                  (setq GA 0.0220)
                  (setq GA GA)
                )


; Calculates the weight of the part

   (setq W (* TPA GA 0.2833))
     (setq W (rtos W 2 4))
     (setq TPA (rtos TPA 2 4))
     (setq TPP (rtos TPP 2 4))

; The following prints answer to the command prompt

  (princ)
  (princ "\nWEIGHT: ")(princ W)
  (princ "\nLASER: ")(princ TPP)
  (princ "\n3. AREA: ")(princ TPA)
  (princ "\nLASER TEXT: ")(princ LTHP)
  (princ)



) ; end of program

[Lee Mac]

Would these (old) programs help at all?

[Biscuits]

Thanks Lee. These were very helpful.
But I'm still trying to understand why this section fails on LWPolylines.

Code: [Select]


(prompt "\n\n SELECT ALL LASER TEXT ON THE PART:")

  (setq CIR (ssget))

 (if CIR
 (progn
  (setq LSSL   (sslength CIR)
        NSSET (ssadd)
  ) ;_ end of setq;

  (while (> LSSL 0.00)
    (setq TEMP (ssname CIR (setq LSSL (1- LSSL))))
      (ssadd TEMP NSSET)
  ) ;_ end of while

  (setq LSSL (sslength NSSET)
        CIR NSSET
  ) ;_ end of setq

  (setq CTR 0)

  (while
    (setq ENT (ssname CIR CTR))
      (command "area" "o" ENT)
    (setq HA (getvar "area"))
    (setq HP (getvar "perimeter"))
     (setq LTHA (+ LTHA HA))
     (setq LTHP (+ LTHP HP))
     (setq CTR (+ 1 CTR))
  ) ;_ end of while

 (princ"   Done...  ")) ;_end of progn
(princ"    Nothing selected.  ")) ;_end of if

  (princ)
     (print LSSL)
     (princ "Laser Text Entities Found. ")
  (princ)
  (princ "\nLASER TEXT: ")(princ LTHP)




command line shows:

Code: [Select]

SELECT ALL LASER TEXT ON THE PART:
Select objects: Specify opposite corner: 5 found

Select objects:

Area calculation failed.


*Invalid selection*
Expects a point or Last
; error: Function cancelled

Select objects:

The text selected was created using polylines and worked in previous versions of Acad.

However, I've noticed when certain numbers (like the number 2 and 5) are selected we have a failure.
Seems to have to do with the poilyline direction taking a sharp turn on itself.

Make any sense?

[ronjonp]

I'd try taking out the command call to get the area .. give this function a whirl:

Code: [Select]

(defun getarea (obj)
  (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
  (if (vlax-property-available-p obj 'area)
    (vla-get-area obj)
    0.
  )
)
*added function for length

Code: [Select]

(defun getlength (obj / ep)
  (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
  (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list obj))))
    0.
    (vlax-curve-getdistatparam obj ep)
  )
)

[ronjonp]

After looking a bit at the code ... IMO it is in need of a re-write (no offense) ... I'm outta time but started to translate it. Perhaps someone else will jump in and help in the meantime. If not, I'll work on it in the morning.

Code: [Select]

(defun c:wla
       (/ ss->list getarea getlength cir ent ga gaugelist ltha lthp msg pa pp ss tha thp tpa tpp w)
  ;;Modified by RJP 02-18-2011   http://www.theswamp.org/index.php?topic=37163.msg421530#msg421530
  (defun ss->list (ss / e n out)
    (setq n -1)
    (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons e out)))
  )
  (defun getarea (obj)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vlax-property-available-p obj 'area)
      (vla-get-area obj)
      0.
    )
  )
  (defun getlength (obj / ep)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list obj))))
      0.
      (vlax-curve-getdistatparam obj ep)
    )
  )
  (setvar "cmdecho" 0)
  ;;Isolates the DWG layer
  (command "layer" "off" "*" "y" "")
  (command "layer" "on" "cnc" "")
  ;;Assoc list to grab gauge thickness
  (setq gaugelist '((3 . 0.2391)
    (4 . 0.2242)
    (5 . 0.2092)
    (6 . 0.1943)
    (7 . 0.1793)
    (8 . 0.1644)
    (9 . 0.1495)
    (10 . 0.1345)
    (11 . 0.1186)
    (12 . 0.1065)
    (13 . 0.0900)
    (14 . 0.0770)
    (15 . 0.0673)
    (16 . 0.0570)
    (17 . 0.0538)
    (18 . 0.0470)
    (19 . 0.0395)
    (20 . 0.0359)
    (21 . 0.0329)
    (22 . 0.0280)
    (23 . 0.0269)
    (24 . 0.0220)
   )
  )
  (if (and (setq ent (car (entsel "\nSelect part: ")))
   (not (zerop (setq pa (getarea ent))))
   (not (zerop (setq pp (getlength ent))))
   (princ "\nSelect all holes on part:")
   (setq cir (ssget '((0 . "circle"))))
   (princ "\nSelect all laser text on part: ")
   (setq ss (ssget '((0 . "*polyline"))))
   (setq ga (cdr (assoc (getint "\nEnter gauge of the part [3 - 24]: ") gaugelist)))
      )
    (progn ;;Get totals for holes and perimeter ?laser text?
   (setq tha (apply '+ (mapcar 'getarea (ss->list cir))))
   (setq thp (apply '+ (mapcar 'getlength (ss->list cir))))
   (setq ltha (apply '+ (mapcar 'getarea (ss->list ss))))
   (setq lthp (apply '+ (mapcar 'getlength (ss->list ss))))
   ;; The following takes the total hole area and subtracts from the part area then
   ;; calculates the total part area. Also takes the total hole perimeter and adds to
   ;; the part perimeter then calculates the total part perimeter.
   (setq tpa (- pa tha))
   (setq tpp (+ pp thp lthp))
   ;; Turns all the layers back on
   (command "layer" "on" "*" "")
   (command "layer" "u" "*" "")
   (command "layer" "t" "*" "")
   ;; Calculates the weight of the part
   (setq w (* tpa ga 0.2833))
   ;;Lets create the message
   (princ (setq msg (strcat "\nWeight = "
    (rtos w 2 4)
    "\nLaser = "
    (rtos tpp 2 4)
    "\nArea = "
    (rtos tpa 2 4)
    "\nLaserText = "
    (rtos lthp 2 4)
    )
  )
   )
   (alert msg)
    )
    (princ "\nAll data needed not entered...")
  )
  (princ)
)

[Biscuits]

Thank you for you hard work. This is much cleaner. This routine was created several years ago and tweaked numerous times by a handful of different people.

The text in question is not really text just simple polylines we created for the purpose of laser cnc operations

Code: [Select]

;;NOT SURE WHAT'S GOING ON HERE, TEXT DOES NOT HAVE AN AREA OR PERIMETER PROPERTY
      ;;(while (> ssl 0.00) (setq temp (ssname cir (setq ssl (1- ssl)))) (ssadd temp nsset)) ;_ end of while
      ;|
      (prompt "\n\n SELECT ALL LASER TEXT ON THE PART:")
We still have issues with the polylines being lwpolylines even though the were created as individual blocks long before lwpolylines existed.
I did find a work around last night by adding the folowing at the beginning of the original code:

Code: [Select]

  (command "Convertpoly" "H" "ALL" "")
I would still like to know why this lwpolyline issue is causing us problems.


Thanks again

[ronjonp]

Thank you for you hard work. This is much cleaner. This routine was created several years ago and tweaked numerous times by a handful of different people.

The text in question is not really text just simple polylines we created for the purpose of laser cnc operations

Code: [Select]

;;NOT SURE WHAT'S GOING ON HERE, TEXT DOES NOT HAVE AN AREA OR PERIMETER PROPERTY
      ;;(while (> ssl 0.00) (setq temp (ssname cir (setq ssl (1- ssl)))) (ssadd temp nsset)) ;_ end of while
      ;|
      (prompt "\n\n SELECT ALL LASER TEXT ON THE PART:")
We still have issues with the polylines being lwpolylines even though the were created as individual blocks long before lwpolylines existed.
I did find a work around last night by adding the folowing at the beginning of the original code:

Code: [Select]

  (command "Convertpoly" "H" "ALL" "")
I would still like to know why this lwpolyline issue is causing us problems.


Thanks again

I updated the code above ... see if it works for you. I'm sure this process could be streamlined a bit more but "real" work beckons  . If you post a sample drawing I'll take a look next week to see what steps could be trimmed out.

[Biscuits]

Works good except if there are no holes and/or test to be selected, the routine just ends with "All data needed not entered.."
There will be times when holes and/or laser text are not present and we want the routine to still provide weight laser & area.
The original routine allows a carrage return to proceed to the next stage.
Attached is a typical drawing file.

Thanks again!

[ronjonp]

Works good except if there are no holes and/or test to be selected, the routine just ends with "All data needed not entered.."
There will be times when holes and/or laser text are not present and we want the routine to still provide weight laser & area.
The original routine allows a carrage return to proceed to the next stage.
Attached is a typical drawing file.

Thanks again!

Give this a try. All you have to do is select the part and enter the gauge.

Code: [Select]

(defun c:wla (/      _midpt ss->list   getarea getlength     _foo   cir    doc    ent
      ga     gaugelist    ll   ltha lthp msg    pa     pp     ss     tha    thp
      tpa    tpp    ur    w   x
     )
  ;;Modified by RJP 02-18-2011   http://www.theswamp.org/index.php?topic=37163.msg421530#msg421530
  (defun _foo (flag name / lays)
    ;;T = on nil = off
    (vlax-map-collection
      (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      '(lambda (x)
(if flag
   (vlax-put x 'layeron -1)
   (if (not (equal (strcase (vla-get-name x)) (strcase name)))
     (vlax-put x 'layeron 0)
     (vlax-put x 'layeron -1)
   )
)
       )
    )
    (princ)
  )
  (defun ss->list (ss / e n out)
    (setq n -1)
    (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons e out)))
  )
  (defun getarea (obj)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vlax-property-available-p obj 'area)
      (vla-get-area obj)
      0.
    )
  )
  (defun getlength (obj / ep)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list obj))))
      0.
      (vlax-curve-getdistatparam obj ep)
    )
  )
  (defun _midpt (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))
  (vl-catch-all-apply 'setvar (list 'clayer "cnc"))
  ;;Isolates the DWG layer
  (_foo nil "cnc")
  ;;Assoc list to grab gauge thickness
  (setq gaugelist '((3 . 0.2391)
    (4 . 0.2242)
    (5 . 0.2092)
    (6 . 0.1943)
    (7 . 0.1793)
    (8 . 0.1644)
    (9 . 0.1495)
    (10 . 0.1345)
    (11 . 0.1186)
    (12 . 0.1065)
    (13 . 0.0900)
    (14 . 0.0770)
    (15 . 0.0673)
    (16 . 0.0570)
    (17 . 0.0538)
    (18 . 0.0470)
    (19 . 0.0395)
    (20 . 0.0359)
    (21 . 0.0329)
    (22 . 0.0280)
    (23 . 0.0269)
    (24 . 0.0220)
   )
  )
  (setq doc (vlax-get-acad-object))
  (if (and (setq ent (car (entsel "\nSelect part: ")))
   (setq pa (getarea ent))
   (setq pp (getlength ent))
   (setq ga (cdr (assoc (getint "\nEnter gauge of the part [3 - 24]: ") gaugelist)))
      )
    (progn ;;Get bounding box of part
   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
   (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
   ;;Zoom to part so ssget will grab items
   (vlax-invoke doc 'zoomcenter (_midpt ll ur) (distance ll ur))
   ;;Grab the other stuff if any
   (setq ss (ssget "_w" ur ll))
   ;;Remove the part from the SS
   (setq ss (vl-remove-if '(lambda (x) (eq x ent)) (ss->list ss)))
   ;;Grab the circles
   (setq cir (vl-remove-if-not '(lambda (x) (eq "CIRCLE" (cdr (assoc 0 (entget x))))) ss))
   ;;Grab the lasertext
   (setq ss (vl-remove-if '(lambda (x) (eq "CIRCLE" (cdr (assoc 0 (entget x))))) ss))
   ;;Get totals
   (setq tha (apply '+ (mapcar 'getarea cir)))
   (setq thp (apply '+ (mapcar 'getlength cir)))
   (setq ltha (apply '+ (mapcar 'getarea ss)))
   (setq lthp (apply '+ (mapcar 'getlength ss)))
   ;; The following takes the total hole area and subtracts from the part area then
   ;; calculates the total part area. Also takes the total hole perimeter and adds to
   ;; the part perimeter then calculates the total part perimeter.
   (setq tpa (- pa tha))
   (setq tpp (+ pp thp lthp))
   ;; Calculates the weight of the part
   (setq w (* tpa ga 0.2833))
   ;;Lets create the message
   (princ (setq msg (strcat "\nWeight = "
    (rtos w 2 4)
    "\nLaser = "
    (rtos tpp 2 4)
    "\nArea = "
    (rtos tpa 2 4)
    "\nLaserText = "
    (rtos lthp 2 4)
    )
  )
   )
   (alert msg)
    )
    (princ "\nAll data needed not entered...")
  )
  ;; Turns all the layers back on
  (_foo t "cnc")
  (princ)
)

[Biscuits]

Thanks I'll test this Monday.

I see you are from Fort Collin, Colorado.
My son just started his new job as assistant strength & conditioning coach for the Rams...should see an improvement in their football team next year!

Have a good weekend.

[ronjonp]

Thanks I'll test this Monday.

I see you are from Fort Collin, Colorado.
My son just started his new job as assistant strength & conditioning coach for the Rams...should see an improvement in their football team next year!

Have a good weekend.

Cool stuff  I think our team has nowhere to go but up 

You have a nice weekend as well.

[Biscuits]

Hope everybody's weekend went well. Far too short!

Gave this a good testing and it works perfectly. The only issue that came up is when there is an obround or cutout present ......something other than a circle.
There are times when some holes or cutouts are optional. It would be best if we were required to manually select these various holes/cutouts ourselves as well as the laser text.
I've been trying to modify your routine to do so, but I'm not familiar with visual lisp and have only dabbled in autolisp.
Can you reccomend any visual lisp books?
Your help is much appreciated.

[ronjonp]

Here's a version that allows manual selection:

Code: [Select]

(defun c:wla (/      _midpt ss->list   getarea getlength     _foo   cir    doc    ent
      ga     gaugelist    ll   ltha lthp msg    pa     pp     ss     tha    thp
      tpa    tpp    ur    w   x
     )
  ;;Modified by RJP 02-18-2011   http://www.theswamp.org/index.php?topic=37163.msg421530#msg421530
  (defun _foo (flag name / lays)
    ;;T = on nil = off
    (vlax-map-collection
      (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      '(lambda (x)
(if flag
   (vlax-put x 'layeron -1)
   (if (not (equal (strcase (vla-get-name x)) (strcase name)))
     (vlax-put x 'layeron 0)
     (vlax-put x 'layeron -1)
   )
)
       )
    )
    (princ)
  )
  (defun ss->list (ss / e n out)
    (setq n -1)
    (if (= (type ss) 'pickset)
      (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons e out)))
    )
  )
  (defun getarea (obj)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vlax-property-available-p obj 'area)
      (vla-get-area obj)
      0.
    )
  )
  (defun getlength (obj / ep)
    (and (= (type obj) 'ename) (setq obj (vlax-ename->vla-object obj)))
    (if (vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list obj))))
      0.
      (vlax-curve-getdistatparam obj ep)
    )
  )
  (defun _midpt (p1 p2) (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p1 p2)))
  (vl-catch-all-apply 'setvar (list 'clayer "cnc"))
  ;;Isolates the DWG layer
  (_foo nil "cnc")
  ;;Assoc list to grab gauge thickness
  (setq gaugelist '((3 . 0.2391)
    (4 . 0.2242)
    (5 . 0.2092)
    (6 . 0.1943)
    (7 . 0.1793)
    (8 . 0.1644)
    (9 . 0.1495)
    (10 . 0.1345)
    (11 . 0.1186)
    (12 . 0.1065)
    (13 . 0.0900)
    (14 . 0.0770)
    (15 . 0.0673)
    (16 . 0.0570)
    (17 . 0.0538)
    (18 . 0.0470)
    (19 . 0.0395)
    (20 . 0.0359)
    (21 . 0.0329)
    (22 . 0.0280)
    (23 . 0.0269)
    (24 . 0.0220)
   )
  )
  (setq doc (vlax-get-acad-object))
  (if (and (setq ent (car (entsel "\nSelect part: ")))
   (setq pa (getarea ent))
   (setq pp (getlength ent))
   (setq ga (cdr (assoc (getint "\nEnter gauge of the part [3 - 24]: ") gaugelist)))
      )
    (progn ;;Get bounding box of part
   (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
   (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
   ;;Zoom to part so ssget will grab items
   (vlax-invoke doc 'zoomcenter (_midpt ll ur) (distance ll ur))
   ;;Grab the other stuff if any
   (princ "\nSelect all holes on part:")
   (setq cir (ssget '((0 . "circle,*polyline"))))
   (princ "\nSelect all laser text on part: ")
   (setq ss (ssget '((0 . "*polyline"))))
   ;;Get totals
   (setq tha (apply '+ (mapcar 'getarea (ss->list cir))))
   (setq thp (apply '+ (mapcar 'getlength (ss->list cir))))
   (setq ltha (apply '+ (mapcar 'getarea (ss->list ss))))
   (setq lthp (apply '+ (mapcar 'getlength (ss->list ss))))
   ;; The following takes the total hole area and subtracts from the part area then
   ;; calculates the total part area. Also takes the total hole perimeter and adds to
   ;; the part perimeter then calculates the total part perimeter.
   (setq tpa (- pa tha))
   (setq tpp (+ pp thp lthp))
   ;; Calculates the weight of the part
   (setq w (* tpa ga 0.2833))
   ;;Lets create the message
   (princ (setq msg (strcat "\nWeight = "
    (rtos w 2 4)
    "\nLaser = "
    (rtos tpp 2 4)
    "\nArea = "
    (rtos tpa 2 4)
    "\nLaserText = "
    (rtos lthp 2 4)
    )
  )
   )
   (alert msg)
    )
    (princ "\nAll data needed not entered...")
  )
  ;; Turns all the layers back on
  (_foo t "cnc")
  (princ)
)

[Biscuits]

Absolutely perfect.

I owe you a steak dinner and a couple cold ones.
When I get out to Colorado to see my son, I'll look let you know and make things right.

Many thanks!!!

[ronjonp]

Absolutely perfect.

I owe you a steak dinner and a couple cold ones.
When I get out to Colorado to see my son, I'll look let you know and make things right.

Many thanks!!!

Sounds awesome    Glad to help.