Jump to content

Door lisp routine

shanah

By shanah
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

shanah Rookie

shanah

Posted
Posted (edited)

Below is my companies door lisp routine however i cant figure out how to fix the cut lines. our door block is 40" wide but its cutting a 36" gap any ideas where in this lisp routines i can change this?

  

(defun c:drr ()
    (command "ucsicon" "off")
    (graphscr)
    (setvar "cmdecho" 1)
    (setq slay (getvar "clayer"))
    (setq tst1 nil)
    (setq tst2 nil)
    (setq tst3 nil)
    (command "osnap" "int")
    (setq p1 (getpoint "\nSelect reference intersection: "))
    (command "osnap" "per")
    (setq p2 (getpoint p1 "\nSelect opposite wall: "))
    (command "osnap" "nea")
    (command "ortho" "on")
    (setq p3 (getpoint p1 "\nSelect direction: "))
    (command "ortho" "off")
    (command "osnap" "none")

(setq lay1 (ssget p1))
(setq lay2 (ssname lay1 0))
(setq lay3 (entget lay2))
(setq lay4 (assoc 8 lay3))
(setq lay5 (cdr lay4))
(command "layer" "s" lay5 "")

(if (= #def1 nil)
    (progn
        (initget 12)
        (setq #def1 (getdist "\nDoor return distance <0>: "))
    )
    (progn
        (setq #def2 (rtos #def1))
        (setq #def3 (strcat "\nDoor return distance <" #def2 ">: "))
        (princ #def3)
        (princ)
        (initget 2)
        (setq #def4 (getdist))
        (if (= #def4 nil)
        (setq #def1 (distof #def2))
        (setq #def1 #def4)
        )
    )
    )
    (setq wall_thick (distance p1 p2))
    (setq angl1 (angle p1 p2))
    (setq angl2 (+ angl1 (* 90 0.017452006)))
    (setq angl3 (+ angl1 (* 180 0.017452006)))
    (setq angl4 (+ angl1 (* 270 0.017452006)))
    (if (equal (car p1) (car p2) 0.001)
    (progn (horiz) (setq tst1 "test"))
    (setq tst1 "ali")
    )
    (if (equal (cadr p1) (cadr p2) 0.001)
    (progn(verti)(setq tst2 "test"))
    (setq tst2 "ali")
    )
    (setq tst3 (strcat tst1 tst2))
    
    (if (equal tst3 "aliali")(alin)(+ 1 1))
    (command "layer" "make" "door" "") 
    (command "osnap" "end")
    (setq p5 (getpoint "\nSelect hinge point: "))
    (if (equal p5 pp1 1)
    (command "insert" "x:/blocks/equipment/3d1" pp1 "" "" "")
    (+ 2 2)
    )
    (if (equal p5 pp2 1)
    (command "insert" "x:/blocks/equipment/3d2" pp2 "" "" "")
    (+ 2 2)
    )
    (if (equal p5 pp3 1)
    (command "insert" "x:/blocks/equipment/3d3" pp3 "" "" "")
    (+ 2 2)
    )
    (if (equal p5 pp4 1)
    (command "insert" "x:/blocks/equipment/3d4" pp4 "" "" "")
    (+ 2 2)
    )
(command "layer" "s" slay "")
(command "ucs" "w")
(command "ucsicon" "on")
(COMMAND "OSNAP" "END,MID,CEN,NOD,QUA,PER,INT")
)


 

Edited by CADTutor
Code moved to code block
mhupp Grand Master

mhupp

Posted
Posted

Need three other function

(horiz)

(verti)

(alin)

shanah Rookie

shanah

Posted
  • Author
Posted (edited)

Im not sure where i would put these other functions? the lisp works fine its just cutting a 36" space for a 40" wide door.. Im not very good with lisp routines i definitely didnt write this so i wasnt sure where in the lisp routine its telling it to cut a 36" space so i can change it to 40"

Edited by shanah
shanah Rookie

shanah

Posted
  • Author
Posted

heres a picture of what its doing

Capture.PNG

mhupp Grand Master

mhupp

Posted
Posted (edited)
27 minutes ago, shanah said:

Im not sure where i would put these other functions?

 

Your original lisp calls them in line 50, 54, and 59.

Cant help you unless you post the whole lisp.

 

Error: no function definition <VERTI> ; expected FUNCTION at [eval]

Edited by mhupp
shanah Rookie

shanah

Posted
  • Author
Posted

This is the whole lisp do you mean you need the blocks as well ? I also dont see where the number 50 54 and 59 are in my original lisp ?

mhupp Grand Master

mhupp

Posted
Posted

The line numbers are usually shown in programming software.

image.png.372551c78c2aff50b932ec5bfd767256.png

 

In notepad if

View > Status Bar is checked  look at the bottom

image.png.6bbdffd9c0ec02a2b567b448c08f3546.png

 

Ln 50 = Line 50

Col = Spaces to the right.

 

 

those 3 functoins might not be in that lisp but you have it loaded or it would give you an error like i showed.

 

 

 

 

 

 

Steven P Grand Master

Steven P

Posted
Posted

So back to basics, in the LISP like MHUP says, there are these 3 lines:

(progn (horiz) (setq tst1 "test"))

(progn (verti) (setq tst2 "test"))

(if (equal tst3 "aliali") (alin) (+ 1 1))

and the part in bold between the ( ) are what MHUP is asking about. These are other LISP routines that your LISP uses to complete this one and without seeing them it is tricky to work out what changes to suggest. Looking at this I would suspect that the distances are calculated or are defined in one of these other LISPs. Back to basics, horiz, verti and alin are not standard commands, but custom ones leading us to believe they are other LISPS saved somewhere

 

You might have only copied a part of a LISP file with what you believe is the relevant part, might be more in there. It might be that in the same folder as this one there are other LISP files, could be in there, or .. they could be anywhere (a good place to start looking is the Appload - startup suite contents, and then AutoCADs trusted locations). If you can find them that would help.

shanah Rookie

shanah

Posted
  • Author
Posted

Thank you for breaking that down for me im a newbie and can only do very basic things.. I looked for said lisps in the file and here they are!! 

(defun horiz ()
    (setq tt1 (car p1))
    (setq tt2 (car p3))
    (setq tt3 (cadr p1))
    (setq tt4 (cadr p2))
    (if (> tt1 tt2)
    (progn
        (if (> tt3 tt4)
        (progn
            (setq p11 (polar p1 (* 180 0.017452006) #def1))
            (setq p2 (polar p11 (* 270 0.017452006) wall_thick))
            (setq p4 (polar p2 (* 180 0.017452006) 36))
            (setq p3 (polar p4 (* 90 0.017452006) wall_thick))
            (setq tp1 (polar p11 (* 180 0.017452006) 12))
            (setq tp2 (polar p2 (* 180 0.017452006) 12))
            (COMMAND-S "break" p11 "f" p11 p11)
            (COMMAND-S "break" p2 "f" p2 p2)
            (COMMAND-S "break" p3 "f" p3 p3)
            (COMMAND-S "break" p4 "f" p4 p4)
            (COMMAND-S "erase" tp1 tp2 "")
            (COMMAND-S "line" p11 "per" p2 "")
            (COMMAND-S "line" p3 "per" p4 "")
            (setq pp1 p11)
            (setq pp2 p2)
            (setq pp3 p3)
            (setq pp4 p4)
            (princ)
        )
        (progn
            (setq p11 (polar p1 (* 180 0.017452006) #def1))
            (setq p2 (polar p11 (* 90 0.017452006) wall_thick))
            (setq p4 (polar p2 (* 180 0.017452006) 36))
            (setq p3 (polar p4 (* 270 0.017452006) wall_thick))
            (setq tp1 (polar p11 (* 180 0.017452006) 12))
            (setq tp2 (polar p2 (* 180 0.017452006) 12))
            (COMMAND-S "break" p11 "f" p11 p11)
            (COMMAND-S "break" p2 "f" p2 p2)
            (COMMAND-S "break" p3 "f" p3 p3)
            (COMMAND-S "break" p4 "f" p4 p4)
            (COMMAND-S "erase" tp1 tp2 "")
            (COMMAND-S "line" p11 "per" p2 "")
            (COMMAND-S "line" p3 "per" p4 "")
            (setq pp1 p2)
            (setq pp2 p11)
            (setq pp3 p4)
            (setq pp4 p3)
            (princ)
        )
        )
    )
    (progn
        (if (> tt3 tt4)
        (progn
            (setq p11 (polar p1 0 #def1))
            (setq p2 (polar p11 (* 270 0.017452006) wall_thick))
            (setq p4 (polar p2 0 36))
            (setq p3 (polar p4 (* 90 0.017452006) wall_thick))
            (setq tp1 (polar p11 0 12))
            (setq tp2 (polar p2 0 12))
            (COMMAND-S "break" p11 "f" p11 p11)
            (COMMAND-S "break" p2 "f" p2 p2)
            (COMMAND-S "break" p3 "f" p3 p3)
            (COMMAND-S "break" p4 "f" p4 p4)
            (COMMAND-S "erase" tp1 tp2 "")
            (setq pp1 p3)
            (setq pp2 p4)
            (setq pp3 p11)
            (setq pp4 p2)
            (COMMAND-S "line" p11 "per" p2 "")
            (COMMAND-S "line" p3 "per" p4 "")
            (princ)
        )
        (progn
            (setq p11 (polar p1 0 #def1))
            (setq p2 (polar p11 (* 90 0.017452006) wall_thick))
            (setq p4 (polar p2 0 36))
            (setq p3 (polar p4 (* 270 0.017452006) wall_thick))
            (setq tp1 (polar p11 0 12))
            (setq tp2 (polar p2 0 12))
            (COMMAND-S "break" p11 "f" p11 p11)
            (COMMAND-S "break" p2 "f" p2 p2)
            (COMMAND-S "break" p3 "f" p3 p3)
            (COMMAND-S "break" p4 "f" p4 p4)
            (COMMAND-S "erase" tp1 tp2 "")
            (COMMAND-S "line" p11 "per" p2 "")
            (COMMAND-S "line" p3 "per" p4 "")
            (setq pp1 p4)
            (setq pp2 p3)
            (setq pp3 p2)
            (setq pp4 p11)
            (princ)
        )
        )
    )
    )
)
(defun verti ()
    (COMMAND-S "osnap" "none")
    (COMMAND-S "ucs" "3p" p1 p3 p2)
    (setq p1 (trans p1 0 1))
    (setq p2 (trans p2 0 1))   
    (setq p3 (trans p3 0 1)) 
    (horiz)   
)

(defun alin ()
    (COMMAND-S "osnap" "none")
    (COMMAND-S "ucs" "3p" p1 p3 p2)
    (setq p1 (trans p1 0 1))
    (setq p2 (trans p2 0 1))   
    (setq p3 (trans p3 0 1)) 
    (horiz)
)

shanah Rookie

shanah

Posted
  • Author
Posted

I just changed all of the 36 to 40 and it worked! that has been on my mind for years.. Thank you both for your help

mhupp Grand Master

mhupp

Posted
Posted 
(defun c:drr (/ slay tst1 tst2 tst3 oldsnap p1 p2 p3 p4 p5 lay1 lay2 #def2 #def3 #def4 wall_thick angl1 angl2 angl3 angl4)
  (vl-cmdf "_.ucsicon" "off")
  (graphscr)
  (setvar 'cmdecho 0)  ;turns command echo off
  (setq slay (getvar 'clayer)
        tst1 nil
        tst2 nil
        tst3 nil
        oldsnap (getvar 'osmode)  ;saves osnaps so you can return it after you run this command
  )
  (setvar 'osmode 32)    ;set snap to Intersection
  (setq p1 (getpoint "\nSelect reference intersection: "))
  (setvar 'osmode 128)   ;set snap to perpindicular
  (setq p2 (getpoint p1 "\nSelect opposite wall: "))
  (setvar 'osmode 512)   ;set snap to nearest
  (setvar 'orthomode 1)  ;turn on ortho
  (setq p3 (getpoint p1 "\nSelect direction: "))
  (setvar 'orthomode 0)  ;turn off ortho
  (setvar 'osmode 0)     ;trun off snaps
  (setq lay1 (ssget p1))
  (setq lay2 (cdr (assoc 8 (entget (ssname lay1 0)))))  ;get layer name
  (setvar 'clayer lay2)
  (if (= #def1 nil)
    (progn
      (initget 12)
      (setq #def1 (getdist "\nDoor return distance <0>: "))
    )
    (progn
      (setq #def2 (rtos #def1))
      (setq #def3 (strcat "\nDoor return distance <" #def2 ">: "))
      (initget 2)
      (setq #def4 (getdist))
      (if (= #def4 nil)
        (setq #def1 (distof #def2))
        (setq #def1 #def4)
      )
    )
  )
  (setq wall_thick (distance p1 p2)
        angl1 (angle p1 p2)
        angl2 (+ angl1 (* 90 0.017452006))
        angl3 (+ angl1 (* 180 0.017452006))
        angl4 (+ angl1 (* 270 0.017452006))
  )
  (if (equal (car p1) (car p2) 0.001)
    (progn
      (horiz) (setq tst1 "test")
    )
    (setq tst1 "ali")
  )
  (if (equal (cadr p1) (cadr p2) 0.001)
    (progn
      (verti) (setq tst2 "test")
    )
    (setq tst2 "ali")
  )
  (setq tst3 (strcat tst1 tst2))
  (if (equal tst3 "aliali")
    (alin)
    (+ 1 1)
  )
  (if (tblsearch "Layer" "door")      ;checks for layer door
    (setvar 'clayer "door")           ;if it exists sets clayer to door
    (vl-cmdf "-Layer" "M" "door" "")  ;else makes layer door
  )
  (setvar 'osmode 512)                ;set snap to endpoint
  (setq p5 (getpoint "\nSelect hinge point: "))
  (if (equal p5 pp1 1)
    (command "insert" "x:/blocks/equipment/3d1" pp1 "" "" "")
    (+ 2 2)
  )
  (if (equal p5 pp2 1)
    (command "insert" "x:/blocks/equipment/3d2" pp2 "" "" "")
    (+ 2 2)
  )
  (if (equal p5 pp3 1)
    (command "insert" "x:/blocks/equipment/3d3" pp3 "" "" "")
    (+ 2 2)
  )
  (if (equal p5 pp4 1)
    (command "insert" "x:/blocks/equipment/3d4" pp4 "" "" "")
    (+ 2 2)
  )
  (setvar 'clayer slay                ;returns to layer before command
          'worldview 1
          'osmode oldsnap             ;sets old snaps before command or set to 191 for "END,MID,CEN,NOD,QUA,PER,INT"
  )
  (vl-cmdf "_.ucsicon" "on")
  (setvar 'cmdecho 1)  ;turns command echo back on
  (princ)
)
(defun horiz ()
  (setq tt1 (car p1)
        tt2 (car p3)
        tt3 (cadr p1)
        tt4 (cadr p2)
  )
  (if (> tt1 tt2)
    (progn
      (setq p11 (polar p1 (* 180 0.017452006) #def1)
            p4 (polar p2 (* 180 0.017452006) 40)
            tp1 (polar p11 (* 180 0.017452006) 12)
            tp2 (polar p2 (* 180 0.017452006) 12)
      )
      (if (> tt3 tt4)
        (progn
          (setq p2 (polar p11 (* 270 0.017452006) wall_thick))
          (setq p3 (polar p4 (* 90 0.017452006) wall_thick))
        )
        (progn
          (setq p2 (polar p11 (* 90 0.017452006) wall_thick))
          (setq p3 (polar p4 (* 270 0.017452006) wall_thick))
        )
        (vl-cmdf "_.Break" p11 "f" p11 p11
                 "_.Break" p2 "f" p2 p2
                 "_.Break" p3 "f" p3 p3
                 "_.Break" p4 "f" p4 p4
                 "_.Erase" tp1 tp2 ""
                 "_.Line" "_non" p11 "per" "_non" p2 ""  ; always put "_non" infront of points so snaps doesn't affect it.
                 "_.Line" "_non" p3 "per" "_non" p4 ""
        )
        (if (> tt3 tt4)
          (setq pp1 p11
                pp2 p2
                pp3 p3
                pp4 p4
          )
          (setq pp1 p2
                pp2 p11
                pp3 p4
                pp4 p3
          )
        )
      )
    )
    (progn
      (setq p11 (polar p1 0 #def1)
            p4 (polar p2 0 40)
            tp1 (polar p11 0 12)
            tp2 (polar p2 0 12)
      )
      (if (> tt3 tt4)
        (progn
          (setq p2 (polar p11 (* 270 0.017452006) wall_thick))
          (setq p3 (polar p4 (* 90 0.017452006) wall_thick))
        )
        (progn
          (setq p2 (polar p11 (* 90 0.017452006) wall_thick))
          (setq p3 (polar p4 (* 270 0.017452006) wall_thick))
        )
      )
      (vl-cmdf "_.Break" p11 "f" p11 p11
               "_.Break" p2 "f" p2 p2
               "_.Break" p3 "f" p3 p3
               "_.Break" p4 "f" p4 p4
               "_.Erase" tp1 tp2 ""
      )
      (if (> tt3 tt4)
        (setq pp1 p3
              pp2 p4
              pp3 p11
              pp4 p2
        )
        (setq pp1 p4
              pp2 p3
              pp3 p2
              pp4 p11
        )
      )
      (vl-cmdf "_.Line" "_non" p11 "per" "_non" p2 ""
               "_.Line" "_non" p3 "per" "_non" p4 ""
      )
    )
  )
)
(defun verti ()
  (vl-cmdf "_.UCS" "3P" "_non" p1 "_non" p3 "_non" p2)
  (setq p1 (trans p1 0 1)
        p2 (trans p2 0 1)
        p3 (trans p3 0 1)
  )
  (horiz)
)
(defun alin ()
  (vl-cmdf "_.UCS" "3P" "_non" p1 "_non" p3 "_non" p2)
  (setq p1 (trans p1 0 1)
        p2 (trans p2 0 1)
        p3 (trans p3 0 1)
  )
  (horiz)
)

 

Cleaned up the code a bit.

used setvar instead of sending commands for snaps, ortho, and other things, some other house keeping.

BIGAL Grand Master

BIGAL

Posted
Posted

Perhaps the better answer was do a search here for Door etc and find Dynamic Door block lisp. It has the ability to do the 4 directions as well as sizes. I have a house add on but would redo the doors with a dynamic block next time. Sorry can not remember who posted.

 

For me distance from a end point left or right opening in or out, the wall sizes are predefined, if dont exist get asked for. 3D also so can look inside.

 

image.png.859c6fdcaedb8f21fb9afc7ac1d76842.png

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...