Topic: door lisp

[PKENEWELL]

Thank you PKENEWELL and mhupp for the help

So did you end up with what you wanted?

[mhupp]

People like what they like. Can't fault anyone for that.

As for the door block It needs to been in this orientation at 0 Degrees.

and you have your Angular direction set to clockwise so its rotating the door just in the opposite  direction.
Either (setvar 'angdir 0) or update PKENEWELL's Code to the following. to work with both

Code - Auto/Visual Lisp: [Select]

1. ; get the scale and angle
2. (setq scl (distance p1 p2)
3.       ang1 (angle p1 p2)
4.       ang2 (angle p2 p1)
5. )
6.  
7. ; get the scale and angle
8. (setq scl (distance p1 p2))
9. (if (= (getvar 'angdir 1))
10.   (setq ang1 (- (angle p1 p2))
11.         ang2 (- (angle p2 p1))
12.   )
13.   (setq ang1 (angle p1 p2)
14.         ang2 (angle p2 p1)
15.   )
16. )

--edit
just fig if use mirror if block has text or door numbers it will also be mirrored.

[ronjonp]

Any reason you don't use a dynamic block for this? AutoCAD provides a sample one OOTB.

[PKENEWELL]

Any reason you don't use a dynamic block for this? AutoCAD provides a sample one OOTB.

I agree ronjonp that would be simpler. Perhaps the OP was unaware of them. Maybe however the OP has restrictions on dynamic blocks or is dictated by a customer's standards.

[PKENEWELL]

FWIW; here is another version using both entmake and VLISP calls for the same tasks without any command calls. I prefer not hardcoding the block name and location into the main routine, but I don't know how the OP organizes the blocks. The commands call the main routine with the block desired.

Code - Auto/Visual Lisp: [Select]

1.  
2. ; Commands for specified blocks
3. (defun c:ed1 nil (Insertdoorblock "c:\\blocks\\eArt67.dwg"))
4. (defun c:ed2 nil (Insertdoorblock "c:\\blocks\\eArt68.dwg"))
5.  
6. ; Main routine
7. (Defun InsertDoorBlock ( blkn / *error* adc wsp blkn os p1 p2 rs scl ang blob); localize variables
8.    
9.    ; Load VLISP Functions.
10.    (vl-load-com)
11.  
12.    ; Error handler sub-function
13.    (defun *error* (msg)
14.            (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*quit*,*exit*"))
15.               (princ (strcat "\nError: " msg "\n"))
16.          (princ "\nProgram Aborted.\n")
17.       )
18.       ; restore system variable to original values.
19.      (setvar "osmode" os)
20.      ; End undo group
21.      (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
22.      (princ)
23.    )
24.  
25.   ; Get old value of system variable to be changed.
26.   (setq os (getvar "osmode")
27.         ; Active document object
28.         adc (vla-get-activedocument (vlax-get-acad-object))
29.         ; Layer name
30.         lyr "WINDOOR"
31.   )
32.  
33.    ; Begin undo group
34.   (vla-StartUndoMark adc)
35.  
36.   (setvar "OSMODE" 3) ; end ,mid, 1+2 =3
37.  
38.   (princ "\nPick 2 Points for Door Width and Location: ")
39.   ;; ensures all input is entered before running progam to prevent errors due to operator aborting.
40.   (if (and
41.         (if (findfile blkn) T (progn (princ "\nBlock not found.") nil)) ; Check if Block name exists and return a warning to the command line if not, and a nil value to abort.
42.         (setq p1 (getpoint "\nFirst (Insertion) Point: "))
43.         (setq p2 (getpoint p1 "\nSecond Point: "))
44.       )
45.     (progn
46.        ; check to see if layer exists before creating
47.        (if (not (tblsearch "LAYER" lyr))
48.          (entmake
49.            (list
50.               (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord")
51.               (cons 100 "AcDbLayerTableRecord") (cons 2 lyr)
52.               (cons 70 0) (cons 62 90) (cons 6 "CONTINUOUS")
53.            )
54.          )
55.        )
56.        ; get the scale and angle
57.        (setq scl (distance p1 p2)
58.              ang (angle    p1 p2)
59.              wsp (vla-get-Activespace adc)
60.        )
61.        ; Insert the block
62.        (setq blob (vla-InsertBlock
63.                      (if (= wsp 1)(vla-get-Modelspace adc)(vla-get-Paperspace adc))
64.                      (vlax-3d-point p1) blkn scl scl scl ang
65.                   )
66.        )
67.        (vla-put-layer blob lyr)
68.  
69.        ;; Initialize Input
70.        (initget "Yes No")
71.        ; prompt for flip door and mirror if "Yes".
72.        (if (= (setq rs (getkword "\nFlip Direction? [Yes/No] <No>:")) "Yes")
73.             (progn
74.                (vla-mirror blob (vlax-3D-Point p1) (vlax-3d-point p2))
75.                (vla-Delete blob)
76.             )
77.        )
78.     )
79.   )
80.  
81.   ; restore system variable to original values.
82.   (setvar "osmode" os)
83.  
84.   ; End undo group
85.   (vla-EndUndoMark adc)
86.  
87.   ; exits quietly with no return value
88.   (princ)
89. )
90.