Author Topic: Suggestions for posted LISP  (Read 6362 times)

0 Members and 1 Guest are viewing this topic.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Suggestions for posted LISP
« on: December 24, 2003, 12:04:11 PM »
I have this lisp that will draw in handrails. I need to get this modified so that it will draw in the handrail longer in both directions than the users first and second selections. (i.e. You select the 1st point and then 2nd point, the routine will draw the handrail at the selected points.) I need it to go beyond those 2 points in either direction (overhang). How do I go about that? Autocad R14/2002

Don

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; HANDRAIL.LSP
; Purpose:  Draw a handrail.
;
; Prompts:
;  Radiused ends/<Square ends>:
;  Start point:
;  Endpoint:
;  Mirror? <N>:
;
; Assumptions/Limitations:
;
;==============================================================================
;Initialize
(defun c:handrail (/ ang ang1 len m p1 p2 p3 p4 p5 p6 p7 px type1)
  (setq clayer (getvar "clayer"))
  (setq hdrlst (list
                     (cons "blipmode"  (getvar "blipmode" ))
                     (cons "osmode"  (getvar "osmode" ))
                     (cons "cmdecho"  (getvar "cmdecho" ))
                     (cons "filletrad"  (getvar "filletrad" ))
               )
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  ;==============================================================================
  (initget "Radiused Square")
  (setq type1 (getkword "\nRadius ends/<Square ends>: "))
  (if type1 T (setq type1 "Square"))
  ;==============================================================================
  ;Calculate points and draw polylines
  (while (setq px (getpoint "\nStart point: "))
    (setq pl (getpoint px "\nEndpoint: "))
    (setq len (distance px pl))
    (setq ang (angle px pl))
    (setq ang1 (+ ang 1.5708))
    (setq p1 (polar px ang1 3.0))
    (setq p2 (polar p1 ang len))
    (setq p3 (polar px ang len))
    (setq p4 (polar px ang 1.5))
    (setq p5 (polar p4 ang1 1.5))
    (setq p6 (polar p5 ang (- len 3.0)))
    (setq p7 (polar p4 ang (- len 3.0)))
    (command ".pline" px "w" "0" "" p1 p2 p3 "")  (setq e1 (entlast))
    (command ".pline" p4 p5 p6 p7 "")             (setq e2 (entlast))
    ;==============================================================================
    ;Radius ends if specified
    (if (= type1 "Radiused")
      (progn
        (setvar "filletrad" 2.95) (command ".fillet" "p" e1)
        (setvar "filletrad" 1.49) (command ".fillet" "p" e2)
      )
    )
    ;==============================================================================
    ;Adjust side and angle
    (setq m (strcase (getstring "\nMirror? <N>: ")))
    (if (= m "Y") (command ".mirror" e1 e2 "" px p3 "Y"))
  )
  ;==============================================================================
  ;House cleaning
  (command ".layer" "s" clayer "")
  (foreach cnt hdrlst (setvar (car cnt) (cdr cnt)))
(go3)
  (princ)
)
(defun go3 ()
(setq lname12 "a-flor-hral-shel")
(setq lname13 "a-flor-hral-tent")
(initget 0 "S T")
(setq MODE2 "TENANT")
(setq MODE2 (getkword "\n<S>HELL or <T>ENANT: <T> "))
(if (not MODE2)(setq MODE2 "T"))
  (if (= MODE2 "S")
    (progn
    (z_shell))
  );if
  (if (= MODE2 "T")
    (progn
    (z_tenant))
  );if
(princ)
);defun
(defun z_shell ()
(setq Z_lay1 (tblsearch "layer" "a-flor-hral-shel"))
   (if (= Z_lay1 nil)
(command ".-layer" "new" "a-flor-hral-shel" "c" "1" "a-flor-hral-shel" "l" "continuous" "a-flor-hral-shel" "")
(command ".-layer" "c" "1" "a-flor-hral-shel" "l" "continuous" "a-flor-hral-shel" "")
)
(COMMAND ".CHANGE" e1 "" "PROP" "LAYER" lname12 "")
(COMMAND ".CHANGE" e2 "" "PROP" "LAYER" lname12 "")
(princ)
)
(defun z_tenant ()
(setq Z_lay2 (tblsearch "layer" "a-flor-hral-tent"))
   (if (= Z_lay2 nil)
(command ".-layer" "new" "a-flor-hral-tent" "c" "1" "a-flor-hral-tent" "l" "continuous" "a-flor-hral-tent" "")
(command ".-layer" "c" "1" "a-flor-hral-tent" "l" "continuous" "a-flor-hral-tent" "")
)
(COMMAND ".CHANGE" e1 "" "PROP" "LAYER" lname13 "")
(COMMAND ".CHANGE" e2 "" "PROP" "LAYER" lname13 "")
(princ)
)
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

JohnK

  • Administrator
  • Seagull
  • Posts: 10605
Suggestions for posted LISP
« Reply #1 on: December 24, 2003, 01:15:55 PM »
This brings up a good point ive been trying to make for awhile now.  What i think you should do is break this code into sections. (Managable ones) I want you to take a "section" out of your main code and create a seperate function for it.  Here, let me give you an example.   I see that you take the time to set up the users enviroment and everything. Wouldnt a seperate procedure be nice for that? One that you can use in all your future code. (Ok, that was an easy one ...but the concept is the same.)

Another (better) example:
Let's say my main procedure had these lines in it.
(* 3 3 3)
(* 4 4 4)
(* 5 5 5)
(* 6 6 6)
It would be better to have a seperate procedure like this:
(defun cube (x) (* x x x))
and call that procdure for each time we need to cube an expression.

Doing this will be better for you in the long run. You can quickly change the value of several variables by changing the calculation procedure.

Im sorry for the lack of "code help", Ill look your code over, but for now look into my sudgestion and tell me what you think.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Suggestions for posted LISP
« Reply #2 on: December 24, 2003, 01:48:56 PM »
One other hard part I have yet to figure out is once the handrail is drawn I need to trim out the tread lines that intersect the handrail that protrude through the handrail.
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

daron

  • Guest
Suggestions for posted LISP
« Reply #3 on: December 24, 2003, 02:07:57 PM »
And the way you call the cube expression would be like this:
(setq a (cube 3)
         b (cube 4)
         c (cube 5)
         d (cube 6)
)
or if you don't want to set it to a variable for future use and just use it do this:
(cube 3)

If you'll take your routine and break it up as 7 says, it'll make it easier for us to help you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Suggestions for posted LISP
« Reply #4 on: December 28, 2003, 06:35:10 PM »
Don,

Try this. Replace you code segment.

Code: [Select]

  ;Calculate points and draw polylines
  (while (setq px (getpoint "\nStart point: "))
    (setq pl (getpoint px "\nEndpoint: "))
   
    (setq ang (angle px pl))
    (setq ed 6) ; extend distance
    (setq pl (polar pl ang ed)) ; extend pl
    (setq px (polar px (+ ang pi) ed)) ; extend px

    (setq len (distance px pl))
   
    (setq ang1 (+ ang 1.5708))
   
 
    (setq p1 (polar px ang1 3.0))
    (setq p2 (polar p1 ang len))
    (setq p3 (polar px ang len))
    (setq p4 (polar px ang 1.5))
    (setq p5 (polar p4 ang1 1.5))
    (setq p6 (polar p5 ang (- len 3.0)))
    (setq p7 (polar p4 ang (- len 3.0)))
    (command ".pline" px "w" "0" "" p1 p2 p3 "")  (setq e1 (entlast))
    (command ".pline" p4 p5 p6 p7 "")             (setq e2 (entlast))
    ;==============================================================================
 



For the other problem use something like this

(command "Trim" e2 "F" (polar p5 ang1) (polar p6 ang1) "")

CAB
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Anonymous

  • Guest
Suggestions for posted LISP
« Reply #5 on: December 28, 2003, 08:03:16 PM »
Thanks for your help. Everything works with the exception of the trimming part. Any ideas?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Suggestions for posted LISP
« Reply #6 on: December 28, 2003, 08:31:12 PM »
Post the routine with the part that is supposed to be trimmed & I'll take a look.

Or e-mail it to me ab2draft@tampabay.rr.com


CAB
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Suggestions for posted LISP
« Reply #7 on: December 28, 2003, 08:32:46 PM »
(defun c:handrail ();(/ ang ang1 len m p1 p2 p3 p4 p5 p6 p7 px type1)
  (setq clayer (getvar "clayer"))
  (setq hdrlst (list
                     (cons "blipmode"  (getvar "blipmode" ))
                     (cons "osmode"  (getvar "osmode" ))
                     (cons "cmdecho"  (getvar "cmdecho" ))
                     (cons "filletrad"  (getvar "filletrad" ))
               )
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  ;==============================================================================
  (initget "Radiused Square")
  (setq type1 (getkword "\nRadius ends/<Square ends>: "))
  (if type1 T (setq type1 "Square"))
  ;==============================================================================
    ;Calculate points and draw polylines
    (setvar "osmode" 33)
    (while (setq px (getpoint "\nStart point: "))
      (setq pl (getpoint px "\nEndpoint: "))
      (setvar "osmode" 0)
      (setq ang (angle px pl))
      (setq ed 4) ; extend distance
      (setq pl (polar pl ang ed)) ; extend pl
      (setq px (polar px (+ ang pi) ed)) ; extend px
      (setq len (distance px pl))
      (setq ang1 (+ ang 1.5708))    
      (setq p1 (polar px ang1 3.0))
      (setq p2 (polar p1 ang len))
      (setq p3 (polar px ang len))
      (setq p4 (polar px ang 1.5))
      (setq p5 (polar p4 ang1 1.5))
      (setq p6 (polar p5 ang (- len 3.0)))
      (setq p7 (polar p4 ang (- len 3.0)))
      (command ".pline" px "w" "0" "" p1 p2 p3 "")  (setq e1 (entlast))
    (command ".pline" p4 p5 p6 p7 "")             (setq e2 (entlast))
    (command "Trim" e1 e2 "F" (polar p5 ang) (polar p6 ang) "") <---------This is not working correctly
      ;==============================================================================
    ;Radius ends if specified
    (if (= type1 "Radiused")
      (progn
        (setvar "filletrad" 2.95) (command ".fillet" "p" e1)
        (setvar "filletrad" 1.49) (command ".fillet" "p" e2)
      )
    )
    ;==============================================================================
    ;Adjust side and angle
    (setq m (strcase (getstring "\nMirror? <N>: ")))
    (if (= m "Y") (command ".mirror" e1 e2 "" px p3 "Y"))
  );end while
  ;==============================================================================
  ;House cleaning
  (command ".layer" "s" clayer "")
  (foreach cnt hdrlst (setvar (car cnt) (cdr cnt)))
(go3)
  (princ)
)
(defun go3 ()
(setq lname12 "a-flor-hral-shel")
(setq lname13 "a-flor-hral-tent")
(initget 0 "S T")
(setq MODE2 "TENANT")
(setq MODE2 (getkword "\n<S>HELL or <T>ENANT: <T> "))
(if (not MODE2)(setq MODE2 "T"))
  (if (= MODE2 "S")
    (progn
    (z_shell))
  );if
  (if (= MODE2 "T")
    (progn
    (z_tenant))
  );if
(princ)
);defun
(defun z_shell ()
(setq Z_lay1 (tblsearch "layer" "a-flor-hral-shel"))
   (if (= Z_lay1 nil)
   (command ".-layer" "new" "a-flor-hral-shel" "c" "1" "a-flor-hral-shel" "l" "continuous" "a-flor-hral-shel" "")
   (command ".-layer" "c" "1" "a-flor-hral-shel" "l" "continuous" "a-flor-hral-shel" "")
)
(COMMAND ".CHANGE" e1 "" "PROP" "LAYER" lname12 "")
(COMMAND ".CHANGE" e2 "" "PROP" "LAYER" lname12 "")
(princ)
)
(defun z_tenant ()
(setq Z_lay2 (tblsearch "layer" "a-flor-hral-tent"))
   (if (= Z_lay2 nil)
   (command ".-layer" "new" "a-flor-hral-tent" "c" "1" "a-flor-hral-tent" "l" "continuous" "a-flor-hral-tent" "")
   (command ".-layer" "c" "1" "a-flor-hral-tent" "l" "continuous" "a-flor-hral-tent" "")
)
(COMMAND ".CHANGE" e1 "" "PROP" "LAYER" lname13 "")
(COMMAND ".CHANGE" e2 "" "PROP" "LAYER" lname13 "")
(princ)
)
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Suggestions for posted LISP
« Reply #8 on: December 28, 2003, 08:55:07 PM »
Here try this...


Code: [Select]
(command "Trim" e1 e2 "" "F" (polar p5 ang1 1) (polar p6 ang1 1) "" "")
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Suggestions for posted LISP
« Reply #9 on: December 28, 2003, 09:31:50 PM »
It works if the handrail does not need mirroring but if the user selects to Mirror the handrail then the trimming does not work.

(defun c:handrail ();(/ ang ang1 len m p1 p2 p3 p4 p5 p6 p7 px type1)
(setq clayer (getvar "clayer"))
(setq hdrlst (list
(cons "blipmode" (getvar "blipmode" ))
(cons "osmode" (getvar "osmode" ))
(cons "cmdecho" (getvar "cmdecho" ))
(cons "filletrad" (getvar "filletrad" ))
)
)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
;==============================================================================
(initget "Radiused Square")
(setq type1 (getkword "\nRadius ends/<Square ends>: "))
(if type1 T (setq type1 "Square"))
;==============================================================================
;Calculate points and draw polylines
(setvar "osmode" 33)
(while (setq px (getpoint "\nStart point: "))
(setq pl (getpoint px "\nEndpoint: "))
(setvar "osmode" 0)
(setq ang (angle px pl))
(setq ed 4) ; extend distance
(setq pl (polar pl ang ed)) ; extend pl
(setq px (polar px (+ ang pi) ed)) ; extend px
(setq len (distance px pl))
(setq ang1 (+ ang 1.5708))
(setq p1 (polar px ang1 3.0))
(setq p2 (polar p1 ang len))
(setq p3 (polar px ang len))
(setq p4 (polar px ang 1.5))
(setq p5 (polar p4 ang1 1.5))
(setq p6 (polar p5 ang (- len 3.0)))
(setq p7 (polar p4 ang (- len 3.0)))
(command ".pline" px "w" "0" "" p1 p2 p3 "") (setq e1 (entlast))
(command ".pline" p4 p5 p6 p7 "") (setq e2 (entlast))
;==============================================================================
;Radius ends if specified
(if (= type1 "Radiused")
(progn
(setvar "filletrad" 2.95) (command ".fillet" "p" e1)
(setvar "filletrad" 1.49) (command ".fillet" "p" e2)
)
)
;==============================================================================
;Adjust side and angle
(setq m (strcase (getstring "\nMirror? <N>: ")))
(if (= m "Y") (command ".mirror" e1 e2 "" px p3 "Y"))
(command ".Trim" e1 e2 "" "F" (polar p5 ang1 1) (polar p6 ang1 1) "" "")
);end while

;==============================================================================
;House cleaning
(command ".layer" "s" clayer "")
(foreach cnt hdrlst (setvar (car cnt) (cdr cnt)))
(princ)
);end defun
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Suggestions for posted LISP
« Reply #10 on: December 29, 2003, 09:59:51 AM »
don,

Here is your problem as I see it.

When you mirror the handrail polylines you delete e1 & e2 and create two
new entities which you must trim between.

So the following change must be made:

Code: [Select]
   (setq m (strcase (getstring "\nMirror? <N>: ")))
    (if (= m "Y")
      (progn
         (command ".mirror" e1 e2 "" px p3 "Y")
         (setq e2 (entlast)) ; get the last entity
         (setq e1 (EntBeforeLast e2)) ; get the entity before e2
          ; code needed here to get vertex of polylines e1 & e2
          ; code needed here to  trim between the new points
      )
       ; else trim using known entities & points (remove the previous trim command)
      (command "Trim" e1 e2 "" "F" (polar p5 ang1 1) (polar p6 ang1 1) "" "")
    )


Here is the routine to get the new e1

Code: [Select]
(defun EntBeforeLast(enlast / enBefore NextEnt)
 (setq enBefore (entnext))    ; Gets name of first entity.
 (setq NextEnt (entnext enBefore)) ; get the next entity
 (while (not(equal NextEnt enlast))
   (setq enBefore NextEnt)
  (setq NextEnt (entnext enBefore))
 )
 enBefore
)


I have run out of time today, so perhaps someone has a better idea or
time to help you complete the code.

CAB
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.