Command Line Options in Lisp

[jayhay35365091]

Hey everybody,

I have a current program that I had some help putting together awhile back. I'm trying to add some additional functionality but having some problems. The current program ,in a nutshell, draws lineweighted polylines and adds arrows to the ends. It also breaks intersecting lines based on a class system. What I'm looking to do is give a command line option that would allow the suppression of the arrows if the user needs. Basically in the command it would say "Pick Next Point with Arrow [Yes/No]". I would want the program to keep running based on the users last input unless they select an option. Any help would be greatly appreciated.


(Defun c:bdpidprocpri2 (/ *error* GenericIistbox _breakpoints _class
pt1 pt2 pt3 LWC ws pwd
scl nl cross int lay o2b
bp ang cm ort
)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(setvar 'cmdecho cm)
(setvar 'orthomode ort)
)

(defun LWPoly (p1 p2 lay wd)
(entmakex (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 2)
(cons 8 lay)
(cons 43 wd)
(Cons 10 p1)
(cons 10 p2)
)
)
)
;_ end of defun
(defun GenericIistbox (lst Title / StrDIA intItem)
(setq StrDIA (load_dialog (findfile "GenericIistbox.dcl")))
(if (not (new_dialog "GenericIistbox" StrDIA))
(exit)
) ;_ end of if
(start_list "StrListS")
(mapcar 'add_list Lst)
(end_list)
(set_tile "Base" Title)
(action_tile "StrListS" "(setq el (get_tile $key))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(EXIT)")
(start_dialog)
(unload_dialog StrDIA)
(nth (atoi el) lst)
) ;_ end of defun
(defun _breakpoints (ent int)
(setq ang (angle (setq 1p (vlax-curve-getstartpoint ent))
(setq 2p (vlax-curve-getEndpoint ent))
) ;_ end of angle
) ;_ end of setq
(list (setq px (polar int ang 0.125))
(polar int (+ ang pi) 0.125)
) ;_ end of list
) ;_ end of defun
(Defun _class (lay)
(vl-some '(lambda (a)
(if (vl-string-search (car a) lay)
a
)
)
'(("PRI" 0.03 1.0)
("SECD" 0.015 1.0)
("UTIL" 0.0 0.0)
)
)
)
(setq ort (getvar 'orthomode)
cm (getvar 'cmdecho))
(setvar 'orthomode 1) (setvar 'cmdecho 0)
(if (and
(setq bl (Cdr (assoc 2 (tblsearch "BLOCK" "FLOWARROW")))
) ;_ end of setq
(setq LWC (Genericiistbox
'("PROC-EMUL-PRI" "PROC-OIL-PRI"
"PROC-WATER-PRI"
"PROC-GAS-PRI"
)
"PROCESS LINES"
)
) ;_ end of setq
(setq pt1 (getpoint "\nPick the first Point: "))
) ;_ end of and
(progn
(setq ws (_class LWC)) ;_ end of setq
(setq pwd (cadr ws)
scl (caddr ws)
) ;_ end of setq
(while (setq pt2 (getpoint pt1 "\nPick Next point:"))
(setq ang (angle pt1 pt2))
(setq cross (ssget "_F"
(list (polar pt1 (angle pt1 pt2) 0.03) pt2)
'((0 . "LWPOLYLINE")
(8 . "*PRI,*SECD,UTIL*")
)
)
) ;_ end of ssget
(setq nl (LWPoly pt1 pt2 LWC pwd))
(entmakex (list (cons 0 "INSERT")
(cons 8 "GRAPH")
(cons 2 bl)
(cons 50 (setq ang (angle pt1 pt2)))
(cons 41 scl)
(cons 42 scl)
(cons 43 scl)
(cons 10 pt2)
) ;_ end of list
)
(if cross
(repeat (setq i (sslength cross))
(setq layr
(Strcase
(Cdr
(assoc 8 (entget
(setq e (ssname cross (setq i (1- i))))
) ;_ end of entget
) ;_ end of assoc
) ;_ end of Cdr
) ;_ end of Strcase
) ;_ end of setq
(setq exl (_Class layr))
(if (setq int (vlax-invoke
(vlax-ename->vla-object nl)
'Intersectwith
(vlax-ename->vla-object e)
acExtendNone
)
)
(progn

(setq o2b
(cond
((eq (Car ws) (car exl))
(if (or (equal ang (/ pi 2.0))
(equal ang (* pi 1.5)))
nl e))
((> (cadr ws) (cadr exl)) e)
((< (cadr ws) (cadr exl)) nl
)
)
)
(command "_break"
o2b
"_non"
(car (setq bp (_breakpoints o2b int)))
"_non"
(cadr bp)
)
)
)
)
)
(setq pt1 pt2)
)
)
)
(setvar "cmdecho" 1)
(command "-overkill" "all" "" "p" "y" "")
(setq ARROW (ssget "x" '((0 . "INSERT") (2 . "FLOWARROW"))))
(command "draworder" ARROW "" "f")
(command "regen")
(setvar "cmdecho" 0)
(*error* "")
(princ)
)
(vl-load-com)

[RORAY.DELANO]

you may be able to use this code that was just submitted by jmsilva to the thread labeled "SELECT OBJECTS OR SETTINGS" started 2015-10-19. If you need help integrating this code into your program, I would be willing to help.




(defun c:demo (/ ans)
(while
(progn
(setvar 'ERRNO 0)
(initget "Settings")
(setq ans (entsel "\nSelect objects [Settings]<exit>: "))
(cond
((= (getvar 'ERRNO) 7)
(princ "\nYou did pick a point, use the point to start the 'select' command...")
(command "_.select" "auto" (cadr (grread nil 1 2)))
(while
(= (getvar 'CMDNAMES) "SELECT")
(command "\\")
)
(setq ss2 (ssget "_P"))
nil
)
((null ans)
(princ "\nYou did press the spacebar or enter, to exit...")
nil
)
((= (type ans) 'STR)
(princ "\nDo the Settings stuff...")
(setq ss2 (ssget '((0 . "INSERT"))))
nil
)
((= (type ans) 'LIST)
(princ "\nYou did select an object...")
(command "_.select" (car ans) "auto")
(while
(= (getvar 'CMDNAMES) "SELECT")
(command "\\")
)
(setq ss2 (ssget "_P"))
nil
)
)
)
)
(princ)
)

[jayhay35365091]

Here's what I have so far


(Defun c:bdpidprocpri2 (/ *error* GenericIistbox _breakpoints _class
pt1 pt2 pt3 LWC ws pwd
scl nl cross int lay o2b
bp ang cm ort
)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(setvar 'cmdecho cm)
(setvar 'orthomode ort)
)

(defun LWPoly (p1 p2 lay wd)
(entmakex (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 2)
(cons 8 lay)
(cons 43 wd)
(Cons 10 p1)
(cons 10 p2)
)
)
)
;_ end of defun
(defun GenericIistbox (lst Title / StrDIA intItem)
(setq StrDIA (load_dialog (findfile "GenericIistbox.dcl")))
(if (not (new_dialog "GenericIistbox" StrDIA))
(exit)
) ;_ end of if
(start_list "StrListS")
(mapcar 'add_list Lst)
(end_list)
(set_tile "Base" Title)
(action_tile "StrListS" "(setq el (get_tile $key))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(EXIT)")
(start_dialog)
(unload_dialog StrDIA)
(nth (atoi el) lst)
) ;_ end of defun
(defun _breakpoints (ent int)
(setq ang (angle (setq 1p (vlax-curve-getstartpoint ent))
(setq 2p (vlax-curve-getEndpoint ent))
) ;_ end of angle
) ;_ end of setq
(list (setq px (polar int ang 0.125))
(polar int (+ ang pi) 0.125)
) ;_ end of list
) ;_ end of defun
(Defun _class (lay)
(vl-some '(lambda (a)
(if (vl-string-search (car a) lay)
a
)
)
'(("PRI" 0.03 1.0)
("SECD" 0.015 1.0)
("UTIL" 0.0 0.0)
)
)
)
(setvar "errno" 0)
(initget "Yes No")
(setq ans (cond ((getkword "\n Do You Want Arrows [Yes/No] <Yes>: "))("Yes")))
(cond
((= "Yes" ans)
(setq ort (getvar 'orthomode)
cm (getvar 'cmdecho))
(setvar 'orthomode 1) (setvar 'cmdecho 0)
(if (and
(setq bl (Cdr (assoc 2 (tblsearch "BLOCK" "FLOWARROW")))
) ;_ end of setq
(setq LWC (Genericiistbox
'("PROC-EMUL-PRI" "PROC-OIL-PRI"
"PROC-WATER-PRI"
"PROC-GAS-PRI"
)
"PROCESS LINES"
)
) ;_ end of setq
(setq pt1 (getpoint "\nPick the first Point: "))
) ;_ end of and
(progn
(setq ws (_class LWC)) ;_ end of setq
(setq pwd (cadr ws)
scl (caddr ws)
) ;_ end of setq
(while (setq pt2 (getpoint pt1 "\nPick Next point:"))
(setq ang (angle pt1 pt2))
(setq cross (ssget "_F"
(list (polar pt1 (angle pt1 pt2) 0.03) pt2)
'((0 . "LWPOLYLINE")
(8 . "*PRI,*SECD,UTIL*")
)
)
) ;_ end of ssget
(setq nl (LWPoly pt1 pt2 LWC pwd))
(entmakex (list (cons 0 "INSERT")
(cons 8 "GRAPH")
(cons 2 bl)
(cons 50 (setq ang (angle pt1 pt2)))
(cons 41 scl)
(cons 42 scl)
(cons 43 scl)
(cons 10 pt2)
) ;_ end of list
)
(if cross
(repeat (setq i (sslength cross))
(setq layr
(Strcase
(Cdr
(assoc 8 (entget
(setq e (ssname cross (setq i (1- i))))
) ;_ end of entget
) ;_ end of assoc
) ;_ end of Cdr
) ;_ end of Strcase
) ;_ end of setq
(setq exl (_Class layr))
(if (setq int (vlax-invoke
(vlax-ename->vla-object nl)
'Intersectwith
(vlax-ename->vla-object e)
acExtendNone
)
)
(progn

(setq o2b
(cond
((eq (Car ws) (car exl))
(if (or (equal ang (/ pi 2.0))
(equal ang (* pi 1.5)))
nl e))
((> (cadr ws) (cadr exl)) e)
((< (cadr ws) (cadr exl)) nl
)
)
)
(command "_break"
o2b
"_non"
(car (setq bp (_breakpoints o2b int)))
"_non"
(cadr bp)
);end command break
);end progn
);end if
);end repeat
);end if cross
(setq pt1 pt2)
);end while
);end progn
);end if
);end first
((= "No" ans)
(setq ort (getvar 'orthomode)
cm (getvar 'cmdecho))
(setvar 'orthomode 1) (setvar 'cmdecho 0)
(if (and
(setq bl (Cdr (assoc 2 (tblsearch "BLOCK" "FLOWARROW")))
) ;_ end of setq
(setq LWC (Genericiistbox
'("PROC-EMUL-PRI" "PROC-OIL-PRI"
"PROC-WATER-PRI"
"PROC-GAS-PRI"
)
"PROCESS LINES"
)
) ;_ end of setq
(setq pt1 (getpoint "\nPick the first Point: "))
) ;_ end of and
(progn
(setq ws (_class LWC)) ;_ end of setq
(setq pwd (cadr ws)
scl (caddr ws)
) ;_ end of setq
(while (setq pt2 (getpoint pt1 "\nPick Next point:"))
(setq ang (angle pt1 pt2))
(setq cross (ssget "_F"
(list (polar pt1 (angle pt1 pt2) 0.03) pt2)
'((0 . "LWPOLYLINE")
(8 . "*PRI,*SECD,UTIL*")
)
)
) ;_ end of ssget
(setq nl (LWPoly pt1 pt2 LWC pwd))
(if cross
(repeat (setq i (sslength cross))
(setq layr
(Strcase
(Cdr
(assoc 8 (entget
(setq e (ssname cross (setq i (1- i))))
) ;_ end of entget
) ;_ end of assoc
) ;_ end of Cdr
) ;_ end of Strcase
) ;_ end of setq
(setq exl (_Class layr))
(if (setq int (vlax-invoke
(vlax-ename->vla-object nl)
'Intersectwith
(vlax-ename->vla-object e)
acExtendNone
)
)
(progn

(setq o2b
(cond
((eq (Car ws) (car exl))
(if (or (equal ang (/ pi 2.0))
(equal ang (* pi 1.5)))
nl e))
((> (cadr ws) (cadr exl)) e)
((< (cadr ws) (cadr exl)) nl
)
)
)
(command "_break"
o2b
"_non"
(car (setq bp (_breakpoints o2b int)))
"_non"
(cadr bp)
);end command break
);end progn
);end if
);end repeat
);end if cross
(setq pt1 pt2)
);end while
);end progn
);end if
);end second
);end cond
(setvar "cmdecho" 1)
(command "-overkill" "all" "" "p" "y" "")
(setq ARROW (ssget "x" '((0 . "INSERT") (2 . "FLOWARROW"))))
(command "draworder" ARROW "" "f")
(command "regen")
(setvar "cmdecho" 0)
(*error* "")
(princ)
)
(vl-load-com)

This gives you the option for arrows before the command starts and sticks with that preference throughout the command. Is there a way to go ahead and start the command with the arrows until the user choses the No option and then suppresses them until the user choses the Yes option?

[RORAY.DELANO]

This may work for you or at least show you where to place the code. it would help if you attached a dwg file that had your flowarrow and a few lwpolylines to test the program on

[jayhay35365091]

Attached is an example with the arrows, lines, and the dialog box code. The code still doesn't want to suppress the arrows when typing no. I'm getting the error "invalid point" when trying to select yes or no.

[jayhay35365091]

I got the routine running correctly with a little playing around. Thanks for your help RORAY.DELANO its well appreciated. Here's the finished code:


(Defun c:bdpidprocpri (/ *error* GenericIistbox _breakpoints _class
pt1 pt2 pt3 LWC ws pwd
scl nl cross int lay o2b
bp ang cm ort
)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(setvar 'cmdecho cm)
(setvar 'orthomode ort)
);end of defun
;========================================
(defun LWPoly (p1 p2 lay wd)
(entmakex (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 2)
(cons 8 lay)
(cons 43 wd)
(Cons 10 p1)
(cons 10 p2)
)
)
);_ end of defun
;========================================
(defun GenericIistbox (lst Title / StrDIA intItem)
(setq StrDIA (load_dialog (findfile "GenericIistbox.dcl")))
(if (not (new_dialog "GenericIistbox" StrDIA))
(exit)
) ;_ end of if
(start_list "StrListS")
(mapcar 'add_list Lst)
(end_list)
(set_tile "Base" Title)
(action_tile "StrListS" "(setq el (get_tile $key))")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(EXIT)")
(start_dialog)
(unload_dialog StrDIA)
(nth (atoi el) lst)
) ;_ end of defun
;========================================
(defun _breakpoints (ent int)
(setq ang (angle (setq 1p (vlax-curve-getstartpoint ent))
(setq 2p (vlax-curve-getEndpoint ent))
) ;_ end of angle
) ;_ end of setq
(list (setq px (polar int ang 0.125))
(polar int (+ ang pi) 0.125)
) ;_ end of list
) ;_ end of defun
;==================================
(Defun _class (lay)
(vl-some '(lambda (a)
(if (vl-string-search (car a) lay)
a
)
)
'(("PRI" 0.03 1.0)
("SECD" 0.015 1.0)
("UTIL" 0.0 0.0)
)
)
)
;=========================================
:adding the default value for ans
(setq ans "Yes")
;so you start the command arrows with being added until changed
;=========================================
;(setvar "errno" 0)
;(initget 1 "Yes No")
;(setq ans (cond ((getkword "\n Do You Want Arrows [Yes/No] <Yes>: "))("Yes")))
(setq ort (getvar 'orthomode)
cm (getvar 'cmdecho))
(setvar 'orthomode 1) (setvar 'cmdecho 0)
(if (and
(setq bl (Cdr (assoc 2 (tblsearch "BLOCK" "FLOWARROW")))
) ;_ end of setq
(setq LWC (Genericiistbox
'("PROC-EMUL-PRI" "PROC-OIL-PRI"
"PROC-WATER-PRI"
"PROC-GAS-PRI"
)
"PROCESS LINES"
)
) ;_ end of setq
(setq pt1 (getpoint "\nPick the first Point: "))
) ;_ end of and
(progn
(setq ws (_class LWC)) ;_ end of setq
(setq pwd (cadr ws)
scl (caddr ws)
) ;_ end of setq

(while
(progn
(initget 128 "Yes No")
(setq pt2 (getpoint pt1 "\nPick Next point or change arrows [Yes/No]:"))
);end progn

;=============added start

(if (= pt2 "Yes")(setq ans "Yes"))
(if (= pt2 "No")(setq ans "No"))
(if (= (type pt2) 'LIST)
(progn
;=============added end
(setq ang (angle pt1 pt2))
(setq cross (ssget "_F"
(list (polar pt1 (angle pt1 pt2) 0.03) pt2)
'((0 . "LWPOLYLINE")
(8 . "*PRI,*SECD,UTIL*")
)
)
) ;_ end of ssget
(setq nl (LWPoly pt1 pt2 LWC pwd))
;===================
; move if to here instead of the cond statement
;everything else is the same in the yes or no cond
; so why have all that code in 2 places to modify
;if something needs to change in the future
;this portion is the only difference between the yes and no
;===================
(if (= ans "Yes")
(progn
(entmakex (list (cons 0 "INSERT")
(cons 8 "GRAPH")
(cons 2 bl)
(cons 50 (setq ang (angle pt1 pt2)))
(cons 41 scl)
(cons 42 scl)
(cons 43 scl)
(cons 10 pt2)
) ;_ end of list
);end of entmake
);end of progn
);end of if
;===================
; end of move if to here instead of the cond statement
;===================
(if cross
(repeat (setq i (sslength cross))
(setq layr
(Strcase
(Cdr
(assoc 8 (entget
(setq e (ssname cross (setq i (1- i))))
) ;_ end of entget
) ;_ end of assoc
) ;_ end of Cdr
) ;_ end of Strcase
) ;_ end of setq
(setq exl (_Class layr))
(if (setq int (vlax-invoke
(vlax-ename->vla-object nl)
'Intersectwith
(vlax-ename->vla-object e)
acExtendNone
)
)
(progn

(setq o2b
(cond
((eq (Car ws) (car exl))
(if (or (equal ang (/ pi 2.0))
(equal ang (* pi 1.5)))
nl e))
((> (cadr ws) (cadr exl)) e)
((< (cadr ws) (cadr exl)) nl
)
)
)
(command "_break"
o2b
"_non"
(car (setq bp (_breakpoints o2b int)))
"_non"
(cadr bp)
);end command break
);end progn
);end if
);end repeat
);end if cross
(setq pt1 pt2)
;=============added srart
);end of progn
);end of if
;=============added end
);end while
);end progn
);end if
;=========================
;removed all of no condition
;=========================
(setvar "cmdecho" 1)
(command "-overkill" "all" "" "p" "y" "")
(setq ARROW (ssget "x" '((0 . "INSERT") (2 . "FLOWARROW"))))
(command "draworder" ARROW "" "f")
(command "regen")
(setvar "cmdecho" 0)
(*error* "")
(princ)
)
(vl-load-com)

There is one more thing if you have the time. The "o2b" function has one bug in it. If you cross multiple vertical lines ,at the same time, of the same "class" the program alternates which line to break (ie it'll break the vertical first, then the horizontal, then the vertical etc....). It would be preferable for the program to always break the vertical line if this occurs. Any thoughts?