Combining two working LISP routines into one - Not working. Need help...

[RLispLearner]

Hi All,

I have two lisp routines and both work great separately. I am trying to combine them into just one working routine.  I don't think I am passing the right information from the first routine into the second because only the first half works. Second half fails.

Routine desired: User selects a circle profile and then selects a group of entities (lines, arcs..etc). A sweep command is done on the entities and then a sphere of the same size as the profile selected is added to the end points.

 

Working routine 1:

First routine does the sweep command on all selected entities (lines, arcs...etc) from a profile that is a circle (NOTE: it will always be a circle). Works great.

(defun c:multisweep ()
(setq
delobjvar (getvar "delobj");Obtaining DELOBJ variable.
prf (entsel "\nPick profile to sweep: ");Select one object that would be profile.
)
(princ "\nSelect paths to sweep along: ");Select multiple paths.
(setq mpth (ssget '((0 . "*line,arc,ellipse,spline,3d solid,circle"))); select all Lines, Arcs and circles
cntr 0
)
(princ (sslength mpth))
(princ " - Paths selected.")
(setvar "delobj" 0);Set DELOBJ variable to 0 to remain profile and paths.
(while (< cntr (sslength mpth))
(setq
sweeppath (ssname mpth cntr)
)
(command "sweep" prf "" sweeppath)
(setq
cntr (+ cntr 1)
)
)
(setq
message " - objects created using sweep command."
)
(princ cntr)
(princ message)
(setvar "delobj" delobjvar);Restoring DELOBJ variable.
(princ)
)

 

Working routine 2:

The second routine adds a sphere (with a diameter from a user input at the command line) to the end points of all selected entities (lines, arcs...etc). Work great.

(defun c:multisphere (/ s sp tmp spherenum)

 (setq spherenum (getreal "\nEnter raduis of sphere size in Inches: ")); user puts in a real number

  (if spherenum
    (prompt (strcat "\nUser entered: " (rtos spherenum))); display the number
    (prompt "\nUser did not provide a number."); display an error
  )

(princ "\nSelect paths to add Spheres: ");Select multiple lines.

    (cond    ((setq s (ssget '((0 .  "*line,arc,ellipse,spline,3d solid,circle"))));  

     (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
     (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (mapcar '(lambda (x)
              (and (not (vl-position x tmp))
               (setq tmp (cons x tmp))

               (vlax-invoke sp 'addsphere x spherenum)
              )
            )
           (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
       )
     )
    )
  )
  (princ)
)
(vl-load-com)

 

Combining both routines together - not working.

I am attempting to combine both routines into one. Its not working unfortunately. I believe I am not passing the correct information of the size of the profile selected to the second part of the routine for the sphere size. I tried to get the real number of the circle profile for the sphere size but maybe that's where it is failing...I don't know...

 

My combined routine attempt:

(defun c:aaa (/ delobjvar prf s sweeppath sp tmp spherenum)

(setq delobjvar (getvar "delobj"));Obtaining DELOBJ variable.

(setq prf (entsel "\nPick profile to sweep: "));Profile will always be a circle


;new code added down----------------
(setq mydiameter (cdr (assoc 40 (entget (entlast))))); get diameter of circle profile selected (dfx code 40)
(setq mydiameterreal (rtos mydiameter)); get 'real number' of diameter of circle profile selected
;new code added up----------------


(princ "\nSelect paths to sweep along: ");Select multiple paths at once.
(setq mpth (ssget '((0 . "*line,arc,ellipse,spline,circle"))); select all Lines, Arcs and circles...etc
cntr 0
)
(princ (sslength mpth))
(princ " - Paths selected.")
(setvar "delobj" 0);Set DELOBJ variable to 0 to remain profile and paths.
(while (< cntr (sslength mpth))
(setq
sweeppath (ssname mpth cntr)
)
(command "sweep" prf "" sweeppath)
(setq
cntr (+ cntr 1)
)
)

;-----------------------------------------------------------------------------------------------------------
;Adding Sphere routine below. Passing along diameter of circle profile as a real number for sphere size
;-----------------------------------------------------------------------------------------------------------

 (setq spherenum mydiameterreal);  Diameter of real number from profile used for sphere size

  (if spherenum
    (prompt (strcat "\nUser entered: " (rtos spherenum))); display the number
    (prompt "\nUser did not provide a number."); display an error
  )

    (cond    ((setq s mpth);  'mpth' = all lines that were originally selected in top routine

     (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (ssname s 0))))))
     (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
       (mapcar '(lambda (x)
              (and (not (vl-position x tmp))
               (setq tmp (cons x tmp))

               (vlax-invoke sp 'addsphere x spherenum); add a sphere to end points with diameter from profile 'mydiameterreal'
              )
            )
           (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
       )
     )
    )
  )

(setvar "delobj" delobjvar);Restoring DELOBJ variable.

(princ)
)

 

Any help or advise appreciated.

Thanks!

[BIGAL]

Try this expects say a profile as you suggested a circle already exists.

 

(defun c:aaa (/ delobjvar prf s sweeppath sp tmp spherenum)

(setq delobjvar (getvar "delobj"))  ;Obtaining DELOBJ variable.
(setvar "delobj" 0)  ;Set DELOBJ variable to 0 to remain profile and paths.

(setq prf (entsel "\nPick profile to sweep: ")) ;Profile will always be a circle

(setq mydiameter (cdr (assoc 40 (entget (car prf))))) ; get diameter of circle profile selected (dfx code 40)
(setq mydiameterreal (rtos mydiameter)) ; get 'real number' of diameter of circle profile selected

(princ "\nSelect paths to sweep along: ") ;Select multiple paths at once.
(setq mpth (ssget '((0 . "*line,arc,ellipse,spline,circle")))) ; select all Lines, Arcs and circles...etc

(princ (strcat "\n" (rtos (sslength mpth) 2 0) " - Paths selected."))

(Repeat  (setq x (sslength mpth))
 (setq sweeppath (ssname mpth (setq x (1- x))))
 (command "sweep" prf "" sweeppath)
 (setq ent1 (entlast))
 (setq obj (vlax-ename->vla-object sweeppath))
 (setq start (vlax-curve-getstartpoint obj))
 (setq end (vlax-curve-getendpoint obj))
 (command "sphere" (vlax-curve-getstartpoint obj) mydiameter)
 (setq ent2 (entlast))
 (command "sphere" (vlax-curve-getendpoint obj) mydiameter)
 (command "union" ent1 ent2 (entlast) "")
)

(setvar "delobj" delobjvar);Restoring DELOBJ variable.

(princ)

)

 

[marko_ribar]

Another one...

 

(defun c:sweepcir+sph2ends ( / *error* cir del len rad sel swp )

  (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com))

  (defun *error* ( m )
    (if del
      (setvar (quote delobj) del)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  (if
    (and
      (not (prompt "\nPick desired circle for profile..."))
      (setq sel (ssget "_+.:E:S" (list (cons 0 "CIRCLE"))))
      (not (prompt "\nSelect path entities on which to apply sweep..."))
      (setq swp (ssget (list (cons 0 "*LINE,ARC,ELLIPSE,CIRCLE,HELIX"))))
    )
    (progn
      (setq del (getvar (quote delobj)))
      (setvar (quote delobj) 0)
      (setq cir (ssname sel 0))
      (setq rad (cdr (assoc 40 (entget cir))))
      (repeat (setq len (sslength swp))
        (vl-cmdf "_.SWEEP" cir "" (ssname swp (setq len (1- len))))
        (while (< 0 (getvar (quote cmdactive)))
          (vl-cmdf "")
        )
        (if 
          (and
            (/= (cdr (assoc 0 (entget (ssname swp len)))) "CIRCLE")
            (not
              (and
                (= (cdr (assoc 0 (entget (ssname swp len)))) "ELLIPSE")
                (vlax-curve-isclosed (ssname swp len))
              )
            )
            (not
              (and
                (wcmatch (cdr (assoc 0 (entget (ssname swp len)))) "*LINE")
                (vlax-curve-isclosed (ssname swp len))
              )
            )
          )
          (progn
            (vl-cmdf "_.SPHERE" "_non" (trans (vlax-curve-getstartpoint (ssname swp len)) 0 1) rad)
            (vl-cmdf "_.SPHERE" "_non" (trans (vlax-curve-getendpoint (ssname swp len)) 0 1) rad)
          )
        )
      )
    )
  )
  (*error* nil)
)

 

[RLispLearner]

Sorry for the late reply. Yes, both solutions worked great! Thank you guys for the help...

[RLispLearner]

Hi all,
I'm attempting to expand on this routine a little in the following:

-I know the profile to be swept will be a circle.
-Based on that, can I have the user either pick an existing circle or just put in the desired diameter of the circle in the command line.

These are the steps I think would be needed, but not sure if I'm on the right track.
Can I get some opinions about my direction or possibly better solutions than what Ive started?

 

MY STEPS:
User either picks existing circle or asked to put in a diameter:

(princ "\n"\nPick circle profile or enter diameter of a circle: \n");
(setq mycircle (ssget)); user selects circle profile
(setq mydiameter (if (nil mycircle (getstring "\nEnter diameter: ")))); if no circle selected type in diameter value at command prompt

 

If nothing selected, create a circle based on use input for sweeping:

(if (/= mydiameter nil (command "circle" "0,0" "d" mydiameter 0 ""); Create circle at 0,0 if diameter given
(setq mynewprofile (ssget "L")); get circle created as an entity for sweeping
....
....
(command "sweep" mynewprofile "" .....)

 

once sweep done, erase created circle

(if (/= mynewprofile nil)(command "erase" mynewprofile ""))

 

Any advise is appreciated!

(Note: I wasn't sure how to edit the subject line.sorry...)

 

 

 

[BIGAL]

Only comment is.

 

(setq mycircle (car (entsel "\nPick a circle or blank space for dia"))); user selects circle profile
(if (= mycircle nil)
 (progn
  (setq dia (getreal "\nEnter diameter: ")))); if no circle selected type in diameter value at command prompt
  (command "circle" (gepoint "\nPick a point for circle ") "D" dia)
  (setq mycircle (entlast))
 )
)

"once sweep done, erase created circle"

(command "erase" mycircle "")

 

Edited October 6 by BIGAL