Thanks Gary,
I am actually in the process of reworking (rewriting) my door and window programs. They were some of the first programs that I had written so they are quite sloppy. Here it the program so far. I am going to create a block from the entities that way they will be more easily modified (flipped - mirrored). My door tags are attributed block that I manually place and move.
;;; ------------------------------------------------------------------------
;;; CreateSingleDoor.lsp v0.1
;;;
;;; Copyright © April 2007
;;; Timothy G. Spangler
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; Single Door Creator:
;;;
;;;
;;;
;;;
;;; Files include:
;;; CreateSingleDoor.lsp - The main routine
;;;
;;; ---Version 0.1----------------------------------------------------------
;;; 04-10 = Started coding Everything is as expected.
;;;
;;; ---Need to be fixed-----------------------------------------------------
;;;
;;;
;;; ------------------------------------------------------------------------
;;; ------------ MAIN FUNCTION
(defun C:SD (/)(SINGLE_DOOR)); Program Shortcut
;; BEGIN PROGRAM
(defun SINGLE_DOOR (/ *error* OldCmdEcho OldOsmode OldClayer)
;; Set environment
(DOOR_SET_ENV)
;; Error Handling Routine
(defun *error* (Msg)
(if (not (member Msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\n*** Program Error: " (strcase Msg) " ***"))
(princ "\n... Program Cancelled ...")
)
(while (< 0 (getvar "cmdactive"))
(command)
)
(DOOR_RESET_ENV)
(princ)
)
(RUN_DOOR)
)
;; RUN DOOR PROGRAM
(defun RUN_DOOR (/ BasePoint NewPoint DoorWidth LineEntity PerpPoint SelectionSet WallThickness WallAngle
SwingAngle DoorAngle WallPoint01 WallPoint02 DoorPoint01 DoorPoint02 DoorPoint03)
(setvar "OSMODE" 512)
(setq DoorWidth (getreal "\n Enter door width: "))
(while
(null
(and
(setq BasePoint (getpoint "\n Select insertsion point for door: "))
(setq SelectionSet (ssget BasePoint '((0 . "LINE"))))
)
)
(princ "\nNo Selection - Select insertsion point for door: ")
)
(setvar "OSMODE" 0)
(setq LineEntity (ssname SelectionSet 0))
(setq PerpPoint (GET_PERP_POINT BasePoint LineEntity))
(setq WallThickness (distance BasePoint NewPoint))
(setq WallAngle (angle BasePoint NewPoint))
(setq SwingAngle (SUBTRACT_ANGLE WallAngle 180))
(setq DoorAngle (SUBTRACT_ANGLE WallAngle 90))
(setq WallPoint01 (polar BasePoint DoorAngle DoorWidth))
(setq WallPoint02 (polar PerpPoint DoorAngle DoorWidth))
(setq DoorPoint01 (polar BasePoint SwingAngle DoorWidth))
(setq DoorPoint02 (polar BasePoint DoorAngle 1.5))
(setq DoorPoint03 (polar DoorPoint01 DoorAngle 1.5))
(command ".break" BasePoint WallPoint01)
(command ".break" PerpPoint WallPoint02)
(vlax-put (vlax-invoke Space 'addline BasePoint PerpPoint)'Layer "A-WALL-FULL")
(vlax-put (vlax-invoke Space 'addline WallPoint01 WallPoint02)'Layer "A-WALL-FULL")
(vlax-invoke Space 'addline BasePoint DoorPoint01)
(vlax-invoke Space 'addline DoorPoint01 DoorPoint03)
(vlax-invoke Space 'addline DoorPoint03 DoorPoint02)
(vlax-invoke Space 'addline DoorPoint02 BasePoint)
(vlax-put
(vlax-invoke Space 'addArc
BasePoint
DoorWidth
(ADD_ANGLE DoorAngle 265.0)
(ADD_ANGLE DoorAngle 360.0)
)
'Color 16)
;; Reset environment
(DOOR_RESET_ENV)
;;Silent exit
(princ)
)
;; GET POINT PERPENDICULAR TO POINT ON PARALLEL LINE
(defun GET_PERP_POINT (Point LineEnt /
WallEntList WallLayer WallStart WallEnd TempPt01 TempPt02 TempBPt01 TempBPt02
WallList TempEntList TempWallLayer TempWallStart TempWallEnd SelPtList
OppWall OppWallStart OppWallEnd WallList Counter EntList TempWallList TempSel01 TempSel02
)
(setq WallEntList (entget LineEnt))
(setq WallLayer (cdr (assoc 8 WallEntList)))
(setq WallStart (trans (cdr (assoc 10 WallEntList)) 0 1))
(setq WallEnd (trans (cdr (assoc 11 WallEntList)) 0 1))
(setq WallAngle (min (angle WallStart WallEnd)(angle WallEnd WallStart)))
(setq TempBPt01 (trans (polar Point (+ WallAngle (/ pi 2)) 1.0) 0 1))
(setq TempBPt02 (trans (polar Point (- WallAngle (/ pi 2)) 1.0) 0 1))
(setq TempPt01 (trans (polar Point (+ WallAngle (/ pi 2)) 12.1) 0 1))
(setq TempPt02 (trans (polar Point (- WallAngle (/ pi 2)) 12.1) 0 1))
(setq TempSel01 (ssget "C"
(list (car TempBPt01)(cadr TempBPt01))
(list (car TempPt01)(cadr TempPt01))
(list (cons 0 "LINE")(cons 8 WallLayer))
))
(setq TempSel02 (ssget "C"
(list (car TempPt02)(cadr TempPt02))
(list (car TempBPt02)(cadr TempBPt02))
(list (cons 0 "LINE")(cons 8 WallLayer))
))
(setq WallList (ssadd))
(if TempSel01
(setq WallList (ssadd (ssname TempSel01 0) WallList))
)
(if TempSel02
(setq WallList (ssadd (ssname TempSel02 0) WallList))
)
(setq Counter 0)
(repeat (sslength WallList)
(setq TempEntList (entget (ssname WallList Counter)))
(setq TempWallLayer (cdr (assoc 8 TempEntList)))
(setq TempWallStart (trans (cdr (assoc 10 TempEntList)) 0 1))
(setq TempWallEnd (trans (cdr (assoc 11 TempEntList)) 0 1))
(setq TempWallAngle (min (angle TempWallStart TempWallEnd)(angle TempWallEnd TempWallStart)))
(if (= (rtos TempWallAngle 2 2)(rtos WallAngle 2 2))
(setq TempWallList (cons (ssname WallList Counter) TempWallList))
)
(setq Counter (1+ Counter))
)
(if (= 1 (length TempWallList))
(progn
(setq OppWall (entget (car TempWallList)))
(setq OppWallStart (trans (cdr (assoc 10 OppWall)) 0 1))
(setq OppWallEnd (trans (cdr (assoc 11 OppWall)) 0 1))
(setq NewPoint (inters TempPt01 TempPt02 OppWallStart OppWallEnd nil))
)
(progn
(alert "The current selection caused an ambiguous condition")
(exit)
)
)
NewPoint
)
;; LAYER CREATOR
(defun DOOR_CREATE_LAYER (Layer Descpition Linetype Thickness Color Plot / TmpList VLA-Obj)
;; Create a list for entmake
(setq TmpList
'((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(70 . 0)
)
)
;; Create layer name list
(setq TmpList (append TmpList (list (cons 2 Layer))))
;; Create layer color list
(setq TmpList (append TmpList (list (cons 62 (atoi Color)))))
;; Create layer linetype list
(setq TmpList (append TmpList (list (cons 6 Linetype))))
;; Create layer lineweight list
(setq TmpList (append TmpList (list (cons 370 (atoi Thickness)))))
;; Create layer plot list
(setq TmpList (append TmpList (list (cons 290 (atoi Plot)))))
;; Create layer from first item in the list
(entmake TmpList)
;; Create layer description
(if(or(= 16.1 (atof(getvar "acadver")))(< 16.1 (atof(getvar "acadver"))))
(progn
(setq VLA-Obj(vla-add LayersCol Layer))
(vla-Put-Description VLA-Obj Descpition)
)
)
(setvar "CLAYER" Layer)
)
;; ADD ANGLE SUBROUTINE
(defun ADD_ANGLE (Radians AddAngle / )
(DTR(+ (RTD Radians) AddAngle))
)
;; SUBTRACT ANGLE SUBROUTINE
(defun SUBTRACT_ANGLE (Radians AddAngle / )
(DTR(- (RTD Radians) AddAngle))
)
;; DEGREES TO RADIANS SUBROUTINE
(defun DTR (NumberOfDegrees)
(* pi (/ NumberOfDegrees 180.0))
)
;; RADIANS TO DEGREES SUBROUTINE
(defun RTD (NumberOfRadians)
(* 180.0 (/ NumberOfRadians pi))
)
;; SET ENVIRONMENT
(defun DOOR_SET_ENV (/)
;; Load VLISP functionality
(vl-load-com)
(setq ActiveDoc (vla-get-activedocument (vlax-get-acad-object)))
(setq Space
(if (= (getvar "cvport") 1)
(vla-get-paperspace ActiveDoc)
(vla-get-modelspace ActiveDoc)
)
)
(setq LayersCol (vla-get-layers ActiveDoc))
;; Set system & envirenment variables
(setq OldCmdEcho (getvar "CMDECHO"))
(setq OldOsmode (getvar "OSMODE"))
(setq OldClayer (getvar "CLAYER"))
(setvar "CMDECHO" 0)
(command "_undo" "BEGIN")
;; Add program description to status line
(grtext -2 "Single Door Creator v0.1 Copyright© 2007")
;; Setup layers
(DOOR_CREATE_LAYER "A-FLOR-DOOR" "Floor Plan - Doors" "Continuous" "15" "11" "0")
)
;; RESET ENVIRONMENT
(defun DOOR_RESET_ENV (/)
(command "_undo" "END")
(setvar "CMDECHO" OldCmdecho)
(setvar "CLAYER" OldCLayer)
(vlax-release-object ActiveDoc)
(vlax-release-object Space)
(vlax-release-object LayersCol)
(grtext -2 "")
(princ)
)
;;;
;;; ------------ Command Line Load Sequence--------------------------------------------
(princ "\nSingle Door Creator v0.1 \n(c)Timothy Spangler, \nApril, 2007....loaded.")
(print)
(princ "Type \"SD\" to start")
(print)
On a side note: Have you been following the development of OpenDCL? You have always had some fantastic and creative dialogs. I think you would gain realestate with the tabbar in OpenDCL. Just curious.
Great to hear from you again.