Drawing and Calculating

[mishgass]

Please I NEED YOUR HELP URGENTLY,,, 

I would like to create a LISP that has a (main Routine and three sub-Routines)

The main routine offers (3) choices to the user.
The Sub-Routine #1 Creates a Drawing.
The Sub-Routine #2 Modify the drawing
The Sub-Routine #3 Analyze Objects within the drawing

* Main Routine [start]
a) switch to a clear text screen
b) offer three choices in a menu
c) wait for a response from the user (see below)

1. Create Objects
2. Manipulate Object
3. Retrieve Information

Please inter a number
If the user presses 1, the sub-routine #1 will be executed. And so one

* Sub-Routine #1 [Routine1]
This will switch to a graph screen, and set the color to RED, then create the rectangle by asking the user to
Pick the "lower-Left" Corner: and then
Pick the "Upper-Right" Corner:
Once the 2 corners have been picked, create a rectangle and circles as shown in the attached picture.

* Sub-Routine #2 [Routine2]
This sub-routine will allow the user to change the color of any objects selected within a window to the color GREEN

Pick the FIRST Corner of a Window:
Pick the SECOND corner of a window:

After the objects have been modified it will respond
Ie. [3] object(s) were changed to the color green

If No objects were found it will respond
There are no objects within the window to change

* Sub-Routine #3 [Routine3]
This Sub-routine will calculate the radius of all the circles within the drawing, and report accumulated total to the user.
Ie. The accumulated radius of all circles within the drawing equals 3.2654124 units

Or There are no objects in the drawing to analyze

Or There are no circles in the drawing to analyze

[fixo]

Try this one:

(princ "\nEnter SOMETEST in command line to run...")

(defun C:sometest (/ choice cnt elist en i wid
oldcol oldecho oldosm p1 p2 p3
p4 pt1 pt2 rad rad_lst rad_lst2
ss ss1 ss2
)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldosm (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcol (getvar "cecolor"))
(command "_.undo" "_m")
;subrout#2
(initget "1 2 3")
(setq choice (getkword "\nEnter choice number (1/2/3)<1>: \n"))
(if (= choice "1")
(progn
(command "_.color" "1")
(setq p1 (getpoint "\nPick lower left corner of rectang\n: >>> "))
(setq
p2 (getcorner p1
"\nPick upper right corner of rectang\n: >>> "
)
)
(setq wid (abs (- (car p2) (car p1)))
hgt (abs (- (cadr p2) (cadr p1))))
(setq p3 (list (+ (car p1) (/ wid 2)) (cadr p1) (caddr p1)))
(setq p4 (list (car p3) (+ (cadr p3) (/ hgt 2)) (caddr p3)))
(vl-cmdf "_.rectang" p1 p2)
(vl-cmdf "_.line" p3 p4 "")
(vl-cmdf "_.circle" p4 (/ hgt 4.))
(vl-cmdf "_.circle" p4 (/ hgt 8.))
;subrout#2
(initget 1)
(setq pt1
(getpoint
"\nPick first corner of the window to select objects\n: >>> "
)
)
(initget 1)
(setq
pt2 (getcorner pt1
"\nPick second corner of the window \n: >>> "
)
)
(if (setq ss (ssget "_W" pt1 pt2))
(progn (setq i -1
cnt 0
)
(repeat (sslength ss)
(setq i (1+ i)
cnt (1+ cnt)
en (ssname ss i)
elist (entget en)
elist (subst (cons 62 3) (assoc 62 elist) elist)
)
(entmod elist)
(entupd en)
)
(princ (strcat "There are "
(itoa cnt)
" object were changed to the color green"
)
)
)
(princ "\nThere are no objects within the window to change")
)
;subrout#3
(setq ss1 (ssget "_X" '((0 . "CIRCLE")))
ss2 (ssadd)
i -1
)
(if (null ss1)
(princ "\nThere are no circles in the drawing to analyze")
(progn
(repeat (sslength ss1)
(setq i (1+ i)
en (ssname ss1 i)
elist (entget en)
rad (cdr (assoc 40 elist))
rad_lst (cons rad rad_lst)
)
(if (equal rad 3.2654124 1.0e-007)
(ssadd en ss2)
)
)
(princ
(strcat "\nTotal legth of all radiuses in the drawing is: "
(rtos (apply '+ rad_lst))
" some units"
)
)
)
)

(if (= (sslength ss2) 0)
(princ
"\nThere are no circles in the drawing with radius equal 3.2654124 units"
)
(progn
(setq i 0)
(repeat (sslength ss2)
(setq i (1+ i)
en (ssname ss2 i)
elist (entget en)
rad (cdr (assoc 40 elist))
rad_lst2 (cons rad rad_lst2)
)
)
(princ
(strcat "\nTotal legth of radiuses equal 3.2654124 units is: "
(rtos (apply '+ rad_lst))
" some units"
)
)
)
)

)
)

(setvar "osmode" oldosm)
(setvar "cmdecho" oldecho)
(setvar "cecolor" oldcol)
(command "_.undo" "_E")
(princ)
)

If any case you will divide this on 3 seperate subroutines
Thanx
Sorry I never learn english...

[fixo]

Another way to calculate total radii length:
http://dwg.ru/forum/viewtopic.php?t=3679&sid=22b50e94363bceb42b0ba87461491d6e

Thanx

[mishgass]

Thank you Fixo
but only option 1 is working, both 2 and 3 don't seem to do anything..

Routine 2 should enable the user to select a window by picking 2 corners and changing all within the window to the color green.

Routine 3 should calculate and accumulate all circles within the window

:)

[fixo]

Excuse me that I it incorrectly understood the condition
of task
If will be time to work I'll try to write the program
and excuse me for the my poor English

Thanx

[fixo]

Attemption #2:

sometest.lsp
(princ "\nEnter SOMETEST in command line to run...")

(defun C:sometest (/ choice cnt elist en i wid
oldcol oldecho oldosm p1 p2 p3
p4 pt1 pt2 rad rad_lst rad_lst2
ss ss1 ss2
)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldosm (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcol (getvar "cecolor"))
(command "_.undo" "_m")

(initget "1 2 3")
(setq choice (getkword "\nEnter choice number (1/2/3): \n"))
(cond ((eq choice "1")
(progn
(alert "Now starts subroutine #1")
(command "_.color" "1")
(setq p1 (getpoint "\nPick lower left corner of rectang\n: >>> "))
(setq
p2 (getcorner p1
"\nPick upper right corner of rectang\n: >>> "
)
)
(setq wid (abs (- (car p2) (car p1)))
hgt (abs (- (cadr p2) (cadr p1))))
(setq p3 (list (+ (car p1) (/ wid 2)) (cadr p1) (caddr p1)))
(setq p4 (list (car p3) (+ (cadr p3) (/ hgt 2)) (caddr p3)))
(vl-cmdf "_.rectang" p1 p2)
(vl-cmdf "_.line" p3 p4 "")
(vl-cmdf "_.circle" p4 (/ wid 4))
(vl-cmdf "_.circle" p4 (/ wid 8))))

((eq choice "2")
(progn
(alert "Now starts subroutine #2")
(initget 1)
(setq pt1
(getpoint
"\nPick first corner of the window to select objects\n: >>> "
)
)
(initget 1)
(setq
pt2 (getcorner pt1
"\nPick second corner of the window \n: >>> "
)
)
(if (setq ss (ssget "_W" pt1 pt2))
(progn (setq i -1
cnt 0
)
(repeat (sslength ss)
(setq i (1+ i)
cnt (1+ cnt)
en (ssname ss i)
elist (entget en)
elist (subst (cons 62 3) (assoc 62 elist) elist)
)
(entmod elist)
(entupd en)
)
(princ (strcat "There are "
(itoa cnt)
" object were changed to the color green"
)
)
)
(princ "\nThere are no objects within the window to change")
)))
((eq choice "3")
(progn
(alert "Now starts subroutine #3")
(setq ss1 (ssget "_X" '((0 . "CIRCLE")))
ss2 (ssadd)
i -1
)
(if (null ss1)
(princ "\nThere are no circles in the drawing to analyze")
(progn
(repeat (sslength ss1)
(setq i (1+ i)
en (ssname ss1 i)
elist (entget en)
rad (cdr (assoc 40 elist))
rad_lst (cons rad rad_lst)
)
(if (equal rad 3.2654124 1.0e-007)
(ssadd en ss2)
)
)
(princ
(strcat "\nTotal legth of all radiuses in the drawing is: "
(rtos (apply '+ rad_lst))
" some units"
)
)
)
)

(if (= (sslength ss2) 0)
(princ
"\nThere are no circles in the drawing with radius equal 3.2654124 units"
)
(progn
(setq i 0)
(repeat (sslength ss2)
(setq i (1+ i)
en (ssname ss2 i)
elist (entget en)
rad (cdr (assoc 40 elist))
rad_lst2 (cons rad rad_lst2)
)
)
(princ
(strcat "\nTotal legth of radiuses equal 3.2654124 units is: "
(rtos (apply '+ rad_lst))
" some units"
)
)
)
)

)
)
)
(setvar "osmode" oldosm)
(setvar "cmdecho" oldecho)
(setvar "cecolor" oldcol)
(command "_.undo" "_E")
(princ)
)

I hope this will be better...

Please delete all alerts in the listing

Thanx

[mishgass]

Hi fixo, don't worry about your English, its fine.

i tried the lisp, but its not working well.

Sub-Routine2 doesn't work, it should turn all objects within a window to the color green

Sub-Routine3 should calculate all circles within a window and give the accumulate of all the RAD. the number (3.2654124) is just an example. sorry if i didn't explain this well.
ie. if i pick a window and there are 2 circles or more, this Sub-Routine should calculate all there RAD and accumulate them and write the total of circle RAD.

[fixo]

;; Attemption #3:

;; sometest.lsp ;
(princ "\nEnter SOMETEST in command line to run...")

(defun C:sometest (/ choice cnt elist en i wid
oldcol oldecho oldosm p1 p2 p3
p4 pt1 pt2 rad rad_lst rad_lst2
ss ss1 ss2
)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldosm (getvar "osmode"))
(setvar "osmode" 0)
(setq oldcol (getvar "cecolor"))
(command "_.undo" "_m")

(initget "1 2 3")
(setq choice (getkword "\nEnter choice number (1/2/3): \n"))
(cond
((eq choice "1")
(progn
(alert "Now starts subroutine #1")
(command "_.color" "1")
(setq
p1 (getpoint "\nPick lower left corner of rectang\n: >>> ")
)
(setq
p2
(getcorner p1
"\nPick upper right corner of rectang\n: >>> "
)
)
(setq wid (abs (- (car p2) (car p1)))
hgt (abs (- (cadr p2) (cadr p1)))
)
(setq p3 (list (+ (car p1) (/ wid 2)) (cadr p1) (caddr p1)))
(setq p4 (list (car p3) (+ (cadr p3) (/ hgt 2)) (caddr p3)))
(vl-cmdf "_.rectang" p1 p2)
(vl-cmdf "_.line" p3 p4 "")
(vl-cmdf "_.circle" p4 (/ wid 4))
(vl-cmdf "_.circle" p4 (/ wid 8))
)
)

((eq choice "2")
(progn
(alert "Now starts subroutine #2")
(initget 1)
(setq pt1
(getpoint
"\nPick first corner of the window to select objects\n: >>> "
)
)
(initget 1)
(setq
pt2
(getcorner pt1
"\nPick second corner of the window \n: >>> "
)
)

(if (setq ss (ssget "_W" pt1 pt2))
(progn
(setq i -1)
(repeat (sslength ss)
(setq i (1+ i)
en (ssname ss i)
elist (entget en)
)
(if (assoc 62 elist)
(setq elist (subst (cons 62 3) (assoc 62 elist) elist))
(setq elist (append elist (list (cons 62 3))))
)
(entmod elist)
)

(princ (strcat "There are "
(itoa (sslength ss))
" object were changed to the color green"
)
)
)
(princ "\nThere are no objects within the window to change")
)
)
)
((eq choice "3")
(progn
(alert "Now starts subroutine #3")

(initget 1)
(setq pt1
(getpoint
"\nPick first corner of the window to select objects\n: >>> "
)
)
(initget 1)
(setq
pt2
(getcorner pt1
"\nPick second corner of the window \n: >>> "
)
)

(if (and (setq ss (ssget "_W" pt1 pt2 '((0 . "CIRCLE"))))
(>= (sslength ss) 2)
)
(progn
(setq i 0
sum 0
)
(while (< i (sslength ss))
(setq cir (entget (ssname ss i)))
(setq sum (+ sum (cdr (assoc 40 cir)))
i (+ i 1)
)
)
(princ
(strcat "\nTotal summ of all radiuses in the window is: "
(rtos sum)
" some units"
)
)
)

(princ "\nThere are no circles in the window to analyze")

)

)
)
)

(setvar "osmode" oldosm)
(setvar "cmdecho" oldecho)
(setvar "cecolor" oldcol)
(command "_.undo" "_E")
(princ)
)

Please correct another bad things what you want...

Thanx

[tyshofner]

mishgass,

I see you have already had some help on this, but here's my routine anyways. The command right now is TEST but you can change it to what you need. If you need any modifications just let me know.

Ty :mrgreen: