Topic: Generically Combine 2 or more routines consecutively

[MSTG007]

Just curious if it is possible to combine 2 or more routines consecutively in 1 lisp?

I stumbled upon this and that is what brought that questions up.

Code: [Select]

(defun c:sub1()
(princ "Lisp Routine 1")
)
(defun c:sub2()
(princ "Lisp Routine 2")
)
(defun c:MainCommand()
(c:sub1)
(c:sub2)
)
I know you can kinda of do it with a script...

So If I have a couple of lisp routines that I typically push one after another would this setup work for that?

[kdub_nz]

Just curious if it is possible to combine 2 or more routines consecutively in 1 lisp?

I stumbled upon this and that is what brought that questions up.

Code: [Select]

(defun c:sub1()
(princ "Lisp Routine 1")
)
(defun c:sub2()
(princ "Lisp Routine 2")
)
(defun c:MainCommand()
(c:sub1)
(c:sub2)
)
I know you can kinda of do it with a script...

So If I have a couple of lisp routines that I typically push one after another would this setup work for that?

Did you try it ??

[MSTG007]

be nice now....  i forgot how to put the princ load lisp routine and execute it.

[kdub_nz]

< ... > i forgot how to put the princ load lisp routine and execute it.

That's not what you asked. Is that what you want or is it just a comment on the state of things ?

[nobody]

haha...i did this in .net with a line / curve table generator I made... it's kind of goofy really...but it worked. First it fires the line portion, then I place a table, then it fires the curve portion, and places that table....was totally lazy...to combine it all was going to be a major PITA though, so I tell peeps too bad lol

Just curious if it is possible to combine 2 or more routines consecutively in 1 lisp?

I stumbled upon this and that is what brought that questions up.

Code: [Select]

(defun c:sub1()
(princ "Lisp Routine 1")
)
(defun c:sub2()
(princ "Lisp Routine 2")
)
(defun c:MainCommand()
(c:sub1)
(c:sub2)
)
I know you can kinda of do it with a script...

So If I have a couple of lisp routines that I typically push one after another would this setup work for that?

[kdub_nz]

Perhaps something like :

Code - Auto/Visual Lisp: [Select]

1.  
2. ;;;-------------------------------------------------------------------
3. ;; MainCommand.lsp
4. ;; codehimbelonga me 2016.05.26
5. ;;
6.  
7. (if (not (vl-symbol-value 'lib1))
8.   (load "K:\\SUPPORT\\Library101.vlx" "Unable to LOAD 'Library101.vlx' ")
9. )
10.  
11. (if (not (vl-symbol-value 'c:sub1))
12.   (load "K:\\SUPPORT\\Sub1.lsp" "Unable to LOAD 'Sub1.lsp' ")
13. )
14.  
15. (if (not (vl-symbol-value 'c:sub2))
16.   (load "K:\\SUPPORT\\Sub2.lsp" "Unable to LOAD 'Sub2.lsp' ")
17. )
18. (if (not (and (vl-symbol-value 'lib1)
19.               (vl-symbol-value 'c:sub1)
20.               (vl-symbol-value 'c:sub2)
21.          )
22.     )
23.   (alert "\nOoooops, \nThe fan has been hit")
24. )
25. ;;;-------------------------------------------------------------------
26.  
27. (defun c:MainCommand (/ *error*)
28.   (defun *error* (msg)
29.     (if (null (wcmatch (strcase msg t) "*break,*exit*"))
30.       ;;"*break,*cancel*,*exit*"))
31.       (progn (princ (strcat "\nxError: " msg)) (vl-bt))
32.     )
33.     (princ)
34.   )
35.  
36.   (greets "Hello")
37.   (c:sub1)
38.   (c:sub2)
39.   (princ)
40. )
41. (princ)
42. ;;;-------------------------------------------------------------------
43. ;;;-------------------------------------------------------------------
44.  

Code - Auto/Visual Lisp: [Select]

1. ;;;-------------------------------------------------------------------
2. ;;Library101.vlx
3. (defun lib1 () (princ "\nLisp Library 101"))
4. (defun greets (msg)
5.   (princ (strcat "\n" msg " " (getvar "loginname")))
6.   (princ)
7. )
8.  

Code - Auto/Visual Lisp: [Select]

1. ;;;-------------------------------------------------------------------
2. ;;Sub1.lsp
3. (defun c:sub1 () (princ "\nLisp Routine 1"))
4.  
5.  

Code - Auto/Visual Lisp: [Select]

1. ;;;-------------------------------------------------------------------
2. ;;Sub2.lsp
3. (defun c:sub2 () (princ "\nLisp Routine 2"))
4.  

[MSTG007]

< ... > i forgot how to put the princ load lisp routine and execute it.

That's not what you asked. Is that what you want or is it just a comment on the state of things ?

Sorry for not getting back! The answer is; "It's what I want to do." And thanks for what you posted.

[MSTG007]

Ok I am trying this thing out. The Two lisp's that I want to do is

Sub1 - Show Polyline Direction

Sub2 - Change Polyline Direction

(I have all the lisp's in the same support folder.)

I run the command and get the following. (Not Sure what I did wrong.)

Code: [Select]

Command: mc
xError: no function definition: GREETS
Backtrace:
[0.51] (VL-BT)
[1.47] (*ERROR* "no function definition: GREETS")
[2.42] (_call-err-hook #<SUBR @0000000040eb5160 *ERROR*> "no function definition: GREETS")
[3.36] (sys-error "no function definition: GREETS")
:ERROR-BREAK.31 nil
[4.28] (#<SUBR @000000003ca48b88 null-fun-hk> "Hello")
[5.24] (GREETS "Hello")
[6.19] (C:MC)
[7.15] (#<SUBR @0000000040eb52f0 -rts_top->)
[8.12] (#<SUBR @000000003ca48700 veval-str-body> "(C:MC)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
Command:

Code: [Select]


;;-------------------------------------------------------------------

;; MainCommand.lsp

;; codehimbelonga me 2016.05.26

;;

 

(if (not (vl-symbol-value 'lib1))

  (load "Library101.vlx" "Unable to LOAD 'Library101.vlx' ")

)

 

(if (not (vl-symbol-value 'c:sub1))

  (load "Sub1.lsp" "Unable to LOAD 'Sub1.lsp' ")

)



(if (not (vl-symbol-value 'c:sub2))

  (load "Sub2.lsp" "Unable to LOAD 'Sub2.lsp' ")

)

(if (not (and (vl-symbol-value 'lib1)

              (vl-symbol-value 'c:sub1)

              (vl-symbol-value 'c:sub2)

         )

    )

  (alert "\nOoooops, \nThe fan has been hit")

)

;;;-------------------------------------------------------------------

 

(defun c:MC (/ *error*)

  (defun *error* (msg)

    (if (null (wcmatch (strcase msg t) "*break,*exit*"))

      ;;"*break,*cancel*,*exit*"))

      (progn (princ (strcat "\nxError: " msg)) (vl-bt))

    )

    (princ)

  )

 

  (greets "Hello")

  (c:sub1)

  (c:sub2)

  (princ)

)

(princ)

;;;-------------------------------------------------------------------

;;;-------------------------------------------------------------------

 



Code: [Select]

;;;-------------------------------------------------------------------

;;Sub1.lsp

;; Original Code by Luis Esquival http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894
;; Displays the direction of polylines with temporary arrows
;;
;; Modified by RonJonP
;; http://www.theswamp.org/index.php?topic=35706.msg409414#msg409414
(vl-load-com)
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
  (if (and fromvertex p2)
    (progn (setq a1 (angle cen fromvertex)
a2 (angle cen p2)
   )
   (if (or (< a1 a2) (equal a1 a2 0.001))
     (setq d (* r (- a2 a1)))
     (setq d (* r (- (+ 6.2831853 a2) a1)))
   )
    )
    ;; is a circle
    (setq d (* r 6.2831853))
  )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
  (setq dir   (cond ((minusp bulge) -1.0)
    (t 1.0)
      )
theta (* 4.0 (atan (abs bulge)))
  )
  (if (> theta pi)
    (setq theta (- (* 2.0 pi) theta)
  dir (* -1.0 dir)
    )
  )
  (setq theta (/ theta 2.0)
radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
pc    (polar fromvertex beta radio)
  )
  (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
       (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
  (setq closed (vla-get-closed vla_poly))
  (setq endparam (vlax-curve-getendparam vla_poly))
  (setq param endparam)
  (setq i 0)
  (while (> param 0)
    (setq param (1- param))
    (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
    (if (vlax-property-available-p vla_poly 'bulge)
      (setq bulge (vla-getbulge vla_poly (fix i)))
    )
    (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
    (setq dis (distance fromvertex nextvertex))
    (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
    (if (and bulge (not (zerop bulge)))
      (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
     (setq etype "ARC")
      )
      (progn bulge (setq etype "LINE"))
    )
;;;;;;    (if (not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
    (setq vlist (cons (list ;; vertex number
    (+ i 1)
    ;; object type
    etype
    ;; midpoint
    midpt
    ;; start vertex
    fromvertex
    ;; ending vertex
    nextvertex
    ;; curved or straight length
;;;;;;        (if (= eType "ARC")
;;;;;; (strcat
;;;;;;    :rcmPrefixArcText
;;;;;;    (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;; ;; is straight
;;;;;; (rtos dis (rcmd-getUnits-mode) :rcmPrec))
      )
      vlist
)
    )
    (setq i (1+ i))
  )
  (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
  ;; set arrow length according to screen height
  ;; to draw the same arrows at any level of zoom
  (setq unidad (/ (getvar "VIEWSIZE") 15))
  (foreach dat lst_dat
    (setq angf (cadr dat)
  dirf (caddr dat)
  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
  pf2  (polar pfm angf (/ unidad 2.0))
    )
    (if (= dirf 1)
      (setq pf3 (polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
    pf4 (polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
      )
      (setq pftemp pf1
    pf1    pf2
    pf2    pftemp
    pf3    (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
    pf4    (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
      )
    )
    (if flag_dir
      (progn ;; draw green arrow
     ;; when you are changing direction
     (grdraw pf1 pf2 3)
     (grdraw pf2 pf3 3)
     (grdraw pf2 pf4 3)
      )
      (progn ;; draw arrow
     (grdraw pf1 pf2 4)
     (grdraw pf2 pf3 4)
     (grdraw pf2 pf4 4)
      )
    )
  )
  (setq flag_dir nil)
)

;;; Command for test...
(defun c:Sub1 (/ pol obj pol_data)
  (setq pol (car (entsel "\nSelect polyline: "))
obj (vlax-ename->vla-object pol)
pol_data (getlwpolydata obj)
  )
  (dib_flechdir
    (setq lst_dat
   (vl-remove
     nil
     (mapcar (function (lambda (i)
(if (nth 2 i)
   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
)
       )
     )
     pol_data
     )
   )
    )
  )
  (princ)
)


Code: [Select]

;;;-------------------------------------------------------------------

;;Sub2.lsp

(defun c:Sub2 (/ elst vlst newlst new-vlst code42 code210
             obj nam pair clo)
 (command "_.undo" "_be")
 (while (null (setq en1 (entsel "\nPick an object to reverse: "))))
 (setq nam  (car en1)
       elst (entget nam)
       obj  (cdr (assoc 0 elst))
       clo  (= 1 (logand 1 (cdr (assoc 70 (entget nam)))))
 )
 (cond
   ((= obj "LWPOLYLINE")
    (setq new-vlst (list (assoc 10 elst))) ; start point
    (while (setq pair (car elst))
      (cond
        ((= (car pair) 10) ; vertex
         ;; collect vertex list
         (while (member (caar elst) '(10 40 41 42))
           (setq vlst (cons (car elst) vlst)
                 elst (cdr elst))
         ) ; end while
        )
        ((= (car pair) 210) ; extru direction??
         (setq code210 pair
               elst    (cdr elst))
        )
        ((setq newlst (cons pair newlst)
               elst   (cdr elst))
        )
      ) ; end cond stmt
    ) ; end while
    ;;  newlst= entlist less vertex list
    ;;  vlst= vertex list
    (while vlst ;  reverse vertex list
      (if (= (car (setq pair (car vlst))) 42) ; bulge
        ;; reverse the bulge
        (setq code42 (cons 42 (* (cdr pair) -1))
              vlst   (cdr vlst))
      )
      (if (= (car (setq pair (car vlst))) 41)
        ;; reverse the width position
        (setq vlst     (cdr vlst)
              new-vlst (cons (cons 40 (cdr pair)) new-vlst)
              new-vlst (cons (cons 41 (cdr (car vlst))) new-vlst)
              vlst     (cdr vlst))
      )
      (if code42 ; add bulge back to list
        (setq new-vlst (cons code42 new-vlst)
              code42   nil)
      )
      (if (= (car (setq pair (car vlst))) 10)
        (setq new-vlst (cons pair new-vlst)
              vlst     (cdr vlst))
      )
    ) ; end while
    (if clo ; closed pline
      (setq new-vlst (cdr new-vlst)) ; remove the start pt
      (setq new-vlst (reverse(cdr (reverse new-vlst))))
    )
    ;;  new-vlst contains the reverse vertex list
    (setq newlst (append new-vlst newlst))
    (if code210
      (setq newlst (append (list code210) newlst))
    )
    (entmod (reverse newlst))
    (entupd nam) ; Regenerates the polyline entity
   )
   ((= obj "POLYLINE")
    (prompt "\nNot yet working... Old Style Polyline."))
   ((prompt "\nObject selected is not a polyline"))
 ) ; end cond stmt
 (princ)
) ; end defun


[ChrisCarlson]

You can have as many routines in a single .LSP container that you want, provided each routine starts and ends and the non-executable routines are loaded before command calls. Mine goes something like this

Code - Auto/Visual Lisp: [Select]

1. (vl-load-com)
2. ;;---------------------=={ Error Trapping }==----------------------;;
3. (defun *error* (msg)
4.   (and msg
5.        (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*"))
6.        (princ (strcat "\nError: " msg))
7.   )
8. )      
9. ;;------------------------------------------------------------;;
10. (setvars blah 1)
11.  
12. (defun cc:Routine1 (/)
13. (vlax-dosomethinginternally)
14. )
15.  
16. (defun c:Code1 (/)
17. (vlax-dosoemthingcool)
18. )
19.  
20. (defun c:Code3 (/)
21. (vlax-dothis)
22. )
23.  
24. (defun c:Code3 (/)
25. (cc:Routine1 "2")
26. )

[MSTG007]

Interesting... So let me ask. How would you setup the one I just posted. I guess I am having a hard time seeing how to execute the sub1 and then sub2 commands. I get that MC routine starts it. But the Sub commands usually start off by me typing in the command to initialize it.

Again I am prob. not understanding or feeling quit nuts....

[kdub_nz]

The error you're getting is because the library isn't being loaded.
I added that as a demonstration.
just remove the load call for Library101.vlx and the greets function call.

of change the .VLX extension to LSP and change the pathing in the load statements to suit your situation.
The code I posted was just a demo to show capability

It's good to see that the error trap helped solve the problem. You SHOULD have seen a message indicating that the file didn't load.

;;-----

(c:sub1) in the MC function is equivalent to sub1 at the command line.
That's what this is all about .... chaining the commands in one function.

[MSTG007]

WOO HOOO Do you ever just don't get it; and then  (the light bulb turns on in my head).

Thanks for putting up with me on this! I appreciate it a lot!

[kdub_nz]

You're welcome.

It's an important concept ... great to hear you've grasped it.