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
; 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