Script Help (minor tweaks)

Discussion of MicroSurvey CAD related issues and questions.

Moderators: Brian Sloman, Jason Poitras, James Johnston

Script Help (minor tweaks)

Postby mmiller » Fri Jun 14, 2013 11:15 am

I need to modify the below script to work properly with MSCAD (it was an autocad script) the main issue is that USERR1 isn't used by MSCad to catch the input scale factor so I have to manually enter it every time. And where exactly do I change it so it spits out area in hectares and acres rather than just meters squared?

;WArea.LSP - AutoCAD release 14 and later by Gunnar Lang.
(defun C:WArea(/ ITEM ALIST ENAME TXTSET TEST ENAME LAY TOTAL ENTARE TOTARE AREAOUT CSF GRNDARE ACARE)
(setvar "CMDECHO" 0)(command "graphscr")
(setq CSF(getvar "USERR1"));store scale factor on system variable USERR1
(if (= CSF 0)(setq CSF 1.0000))
(print "Routine to write areas of selected plines to the screen.")
;get entities
(setq txtset (ssget)
total (sslength txtset)
test 0
ename (ssname txtset 0)
)
; If not nil, the assoc.list for the entity name is stored in alist:
(if (/= ename nil)(setq alist (entget ename)))
; extract description to variable 'item'
(setq item (cdr(assoc 0 alist)))
;This WHILE function checks the value of memory variable test.
(setq TOTARE 0.0)'start with total area=0
(setq AREAOUT 1);always print to screen
;(setq sumlay "")
;(setq lay "")
(while (< test total)
;(setq item (cdr(assoc 0 alist)))
;(if (= item "POLYLINE")(setq lay (cdr(assoc 8 alist))))
;(if (= item "LWPOLYLINE")(setq lay (cdr(assoc 8 alist))))
;(setq sumlay (strcat " " sumlay " " lay));doesn't work yet

(command "area" "Object" ename)
(setq entAre(rtos (getvar "area")))
(write-line (strcat "Area=" entAre))
(setq TOTARE (+ TOTARE (atof entAre)))
;The routine extracts the next entity name in the selection set,
;by applying the value stored in a memory variable named test to the
;memory variable containing the name of the selection set, txtset:
(setq test (1+ test)
ename (ssname txtset test)
)
)
(setq GRNDARE (/(/ TOTARE CSF)CSF))

(if (>= GRNDARE 10000)(setq ACARE (/(atof(rtos (/ GRNDARE 10000)2 2)) 0.40468561)))
(if (< GRNDARE 10000)(setq ACARE (/(atof(rtos (/ GRNDARE 10000)2 3)) 0.40468561)))

(write-line (strcat "(CSF=" (rtos CSF 2 7) ") Sum of " (itoa test) " areas=" (rtos GRNDARE)))
(if (= AREAOUT 1)(setq PT(getpoint "\nText location for area...")))

(if (= AREAOUT 1)(command "text" PT "90" (strcat "Sum of " (itoa test) " areas=")))
;(if (and (= AREAOUT 1)(>= GRNDARE 10000))(command "text" "" (strcat (rtos (/ GRNDARE 10000)2 2) " ha (" (rtos (/ GRNDARE 4046.8561)2 2) " Ac.)")))
;(if (and (= AREAOUT 1)(< GRNDARE 10000))(command "text" "" (strcat (rtos (/ GRNDARE 10000)2 3) " ha (" (rtos (/ GRNDARE 4046.8561)2 2) " Ac.)")))
(if (and (= AREAOUT 1)(>= GRNDARE 10000))(command "text" "" (strcat (rtos (/ GRNDARE 10000)2 2) " ha (" (rtos ACARE 2 2) " Ac.)")))
(if (and (= AREAOUT 1)(< GRNDARE 10000))(command "text" "" (strcat (rtos (/ GRNDARE 10000)2 3) " ha (" (rtos ACARE 2 2) " Ac.)")))

(setvar "CMDECHO" 1)
(princ) ; Use if ver 2.6+ for "quiet exit" from command
) ;Eof: WArea.LSP
mmiller
 
Posts: 3
Joined: Wed Apr 10, 2013 1:40 pm

Re: Script Help (minor tweaks)

Postby James Johnston » Sun Jun 30, 2013 5:42 am

I want to make sure you know you can inquire the scale factor in a lisp routine. See this article:

http://www.microsurvey.com/helpdesk2/in ... rogramming

_fastarea gives you most of what you need, except I suspect you're finding the scale is not applied correctly... am I correct?
User avatar
James Johnston
 
Posts: 25
Joined: Wed May 14, 2008 7:33 am
Location: Kelowna, BC

Re: Script Help (minor tweaks)

Postby mmiller » Thu Jul 04, 2013 5:54 am

I use the above script only for multiple area inquiry, occasionally I'll have anywhere from 5-100+ polygons that I need to know the area for. Far as I know, with fast area I can only select one polygon at a time then add up the results manually afterwards. This routine automatically adds all the selected areas at the end. I'll read the article thanks
mmiller
 
Posts: 3
Joined: Wed Apr 10, 2013 1:40 pm


Return to MicroSurvey CAD

Who is online

Users browsing this forum: No registered users and 1 guest