Author Topic: Point perpendicular to point (line)  (Read 12180 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Point perpendicular to point (line)
« Reply #15 on: April 10, 2007, 08:11:34 AM »
Nice to see you again Luis. :-)

Thanks.

and yes bothering people again...  :-D
Well you never bothered me. 8-)
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.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Point perpendicular to point (line)
« Reply #16 on: April 10, 2007, 02:21:32 PM »
OK swampers,

I have a small coding issue that I can't seem to solve worked on it all day Friday (when work wasn't getting in the way  :roll: )

I was looking at this thread trying to code a sub that would return a point that was on a line parallel to a picked line and perpendicular from the picked point  Clear??

I want to slim down some of my 3 click routines to a one click routines ie adding doors, windows, etc.   I must have gone through the code in that post 6-7 times but for some reason I can't seem to grasp it.  I am at home now so I don't have the code I was working on yesterday to show were I am (it is probably best it didn't work anyway, I should just try to start from scratch).  Any push in the right direction would be appreciated.

TIM


Tim

Here is what I use (not as sweet as Luis's) It is a modified version of a routine from:
;;;  Original concept by Alvaro J. Fernandez-Velasco - Architect (C)Copyright 2000
It draws the doors parametrically with insertion point at the center of the opening.
This point is saved as xdata so that the routine can rotate, mirror and insert the symbol
tag. The routine uses a two points to pick the place the door and cut the walls followed
by a third pick to locate the swing. This is part of my arch program (not a standalone routine).


Here is the pick points routine with xdata that I got from Peter J.

Code: [Select]
;;;PKR1                   MM                        PKR2
;;; .==================/\  .  /\======================.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Add xdata Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Here is a little example of storing x-data data ActiveX
;;;You have to get used to variants and safearrays to do it.
;;;Peter Jamtgaard
(defun ADD-XDATA-DRWDWLVR (/ ENAM EOBJ STR)
  (vl-load-com) 
  (regapp "DRWDWLVR2")
  (setq ENAM (cdar (entget (entlast)))
EOBJ (vlax-ename->vla-object ENAM)
        STR  (rtos ARCH#ANGL 2 8)
  )
  (vla-setxdata
    EOBJ
    (vlax-make-variant
      (vlax-safearray-fill
(vlax-make-safearray vlax-vbInteger '(0 . 1))
'(1001 1000)
      )
    )
    (vlax-make-variant
      (vlax-safearray-fill
(vlax-make-safearray vlax-vbVariant '(0 . 1))
(list "DRWDWLVR" STR)       
      )
    )
  ) 
  (prin1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Get xdata Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Here is a little example of storing x-data data ActiveX
;;;You have to get used to variants and safearrays to do it.
;;;Peter Jamtgaard
(defun GET-XDATA-DRWDWLVR (/ ENAM EOBJ XDTYPE XDVALUE)
  (vl-load-com) 
  (setq ENAM (cdar OBJX)
EOBJ (vlax-ename->vla-object ENAM)
  )
  (vla-getXData EOBJ "DRWDWLVR" 'XDTYPE 'XDVALUE)
  (mapcar
    '(lambda (X Y)
       (cons X (variant-value Y))
     )
    (vlax-safearray->list XDTYPE)
    (vlax-safearray->list XDVALUE)
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;; Get the Intersection Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;One of the better ways is to use the IntersectWith method:
;;;Written by R. Robert Bell
;;;Takes either ENames or Objects, returns list or nil.
(defun GETINTS-DRWDWLVR (obj1 obj2)
  (foreach
         obj '(obj1 obj2)
    (if (= (type (eval obj)) 'ENAME)
      (set obj
           (vlax-EName->vla-Object
             (eval obj)
           )
      )
    )
  )
  (vlax-Invoke obj1 'IntersectWith obj2 acExtendBoth)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Pick Points Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun DSEC-PKR-PT (/ a b p1 p2 t1 t2 pt ent1 ent2 ent3 dis1 dis2) 
  (defun CEN-BETWEEN-LIN-DOIT ()   
    (setq p1 (cdr (assoc 10 (entget (ssname SS1 0)))))
    (setq p2 (cdr (assoc 11 (entget (ssname SS1 0)))))
    (setq ARCH#ANGL (angle p1 p2))   
    (setq ang (angle p1 p2))
    (setvar "SNAPANG" ang)
    (setq pk1 (ARCH:MIDPOINT p1 p2)) 
    (setq ARCH#CPNT (distance p1 pk1))
    (command ".COPY" (ssname SS1 0) "" pk1 pk1)
    (command "rotate" (entlast) "" pk1 "90")
    (setq ent1 (entlast))
    (setvar "orthomode" 0)   
    (setq pkr1 (cdr (assoc 10 (entget (ssname SS1 0)))))
    (setq pkr2 (cdr (assoc 11 (entget (ssname SS1 0)))))
    (command "dist" a pkr1)
    (setq dis1 (getvar "distance"))
    (command "dist" a pkr2)
    (setq dis2 (getvar "distance")) 
    (cond
      ((> dis1 dis2)(setq pkr pkr2))
      ((< dis1 dis2)(setq pkr pkr1))
    )         
    (cond
      (SS1
       (repeat (sslength SS1)
(setq ent2 (cdr (assoc -1 (entget (ssname SS1 0)))))
(setq t1 (GETINTS-DRWDWLVR ent1 ent2))
(setq ent3 (cdr (assoc -1 (entget (ssname SS1 1)))))
(setq t2 (GETINTS-DRWDWLVR ent1 ent3))
       )
      )
    )   
    (setq pk1 t1)
    (setq pk2 t2) 
    ;;(setq ARCH#WWID (distance t1 t2)) ;wall thickness
    (if ent1 (entdel ent1))
    (princ)
  ) 
  (setvar "osmode" 0)
  (initget 1)
  (setq a (getpoint "\n* Draw a \"Crossing Line\" near insertion point *"))   
  (initget 33)
  (setq b (getpoint a))
  (setq pt (list a b))
  (setq SS1 (ssget "F" pt '((0 . "LINE")))) 
  (cond
    ((or (= SS1 nil) (/= (sslength SS1) 2))
     (ARCH:ALERT-E
       "MsgBox \"
     Door Windows and Louvers
--------------------------------------------------------------------------------------------
     The Wall selected has a Polyline. You must change it to a Line.
     Then try again...\""
     )
    )
    ((CEN-BETWEEN-LIN-DOIT))
  )
  (princ)
)

Gary




Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #17 on: April 10, 2007, 04:21:14 PM »
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.

Code: [Select]

;;; ------------------------------------------------------------------------
;;; 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.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

GDF

  • Water Moccasin
  • Posts: 2081
Re: Point perpendicular to point (line)
« Reply #18 on: April 11, 2007, 09:41:00 AM »
Tim

I like your door routine. I'm always learning from how others find a solution.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #19 on: April 11, 2007, 12:07:22 PM »
Tim

I like your door routine. I'm always learning from how others find a solution.

Gary

Thanks Gary,

This one is turning out ALOT better than my original 4 click door placement program.  I too like to see how others solve the same problems, I believe it helps me as a progr.....hacker.

I'll post the completed product when it is finished.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #20 on: April 18, 2007, 12:37:33 PM »
Hey fellas

here is how the program is shaping up:  (no error checking - yet)

Code: [Select]
;;; ------------------------------------------------------------------------
;;; 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 bInsertPoint (polar (polar BasePoint DoorAngle (/ DoorWidth 2.0)) WallAngle (/ WallThickness 2)))

(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))

;;;;;;;; Create block
(setq InsertPoint (list 0.0 0.0 0.0))
(setq WallPt01 (polar (polar InsertPoint (SUBTRACT_ANGLE 0.0 90)(/ WallThickness 2.0))(SUBTRACT_ANGLE 0.0 180.0)(/ DoorWidth 2.0)))
(setq WallPt02 (polar WallPt01 (add_angle 0.0 90.0) WallThickness))
(setq WallPt03 (polar WallPt01 0.0 DoorWidth))
(setq WallPt04 (polar WallPt02 0.0 DoorWidth))
(setq DoorPt01 WallPt01)
(setq DoorPt02 (polar DoorPt01 (SUBTRACT_ANGLE 0.0 90) DoorWidth))
(setq DoorPt03 (polar DoorPt01 0.0 1.5))
(setq DoorPt04 (polar DoorPt02 0.0 1.5))
(setq SwingStart 265.0)
(setq SwingEnd 360.0)
;;;;;;;;;;; Create Block

(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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Block has to be created at 0,0
(entmake
(list
(cons 0 "BLOCK")
(cons 2 "*U")
(cons 70 1)
(cons 10 (list 0.0 0.0 0.0)) ; INSPOINT
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 DoorPt01)
(cons 11 DoorPt02)
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 DoorPt01)
(cons 11 DoorPt03)
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 DoorPt02)
(cons 11 DoorPt04)
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "LINE")
(cons 10 DoorPt03)
(cons 11 DoorPt04)
(cons 8 "0")
)
)
(entmake
(list
(cons 0 "ARC")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 8 "0")
(cons 62 16)
(cons 100 "AcDbCircle")
(cons 10 DoorPt01)
(cons 40 DoorWidth)
(cons 210 (list 0.0 0.0 1.0))
(cons 100 "AcDbArc")
(cons 50 (DTR SwingStart))
(cons 51 (DTR SwingEnd))
)
)
(setq BlockName (entmake
(list
(cons 0 "ENDBLK")
)
))

;; Create nose insert
(entmake
(list
(cons 0 "INSERT")
(cons 2 BlockName)
(cons 6 "BYLAYER")
(cons 8 "A-FLOR-DOOR")
(cons 10 BInsertPoint);ins point
(cons 50 DoorAngle)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 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)

I got it to draw the door as a block with the insertion point in the middle center of the opening.  So far so good.  I have also created these little guys to help modify the door.

Code: [Select]
;; Mod Door
(defun c:MOD_DOOR (/)

(setq v1 (entsel " \n Select door to modify: "))
(setq v2 (entget (car v1)))
(redraw (car v1) 3)
(initget 1 "Flip F f Mirror M m Rotate R r")
(setq ModType (getkword "\n (Flip/Mirror/Rotate)"))
(cond
((= ModType "Flip")(FLIPDOOR V2))
((= ModType "Mirror")(MIRDOOR V2))
((= ModType "Rotate")(ROTDOOR V2))
)
(redraw (car v1) 4)
)
;; Rotate Door
(defun ROTDOOR (V2 /)

(setq v3 (cdr (assoc 50 v2)))
(setq v3 (ADD_ANGLE v3 180))
(setq v4 (subst (cons 50 v3) (assoc 50 v2) v2))
(entmod v4)
)
;; Flip Door
(defun FLIPDOOR (V2 /)

(setq v3 (cdr (assoc 50 v2)))
(setq v3 (ADD_ANGLE v3 180))
(setq v4 (subst (cons 50 v3) (assoc 50 v2) v2))
(entmod v4)
(setq v5 (cdr (assoc 41 v4)))
(if (minusp v5)
(setq v5 1.0)
(setq v5 -1.0)
)
(setq v6 (subst (cons 41 v5) (assoc 41 v4) v4))
(entmod v6)
)

;; Mirror Door
(defun MIRDOOR (V2 /)

(setq v5 (cdr (assoc 41 v2)))
(if (minusp v5)
(setq v5 1.0)
(setq v5 -1.0)
)
(setq v6 (subst (cons 41 v5) (assoc 41 v2) v2))
(entmod v6)
)

Now what I have thought of doing is to add a point to the door block.  Once the door is selected check for that point (It will be on the end of the door at the latch)  Get the point location and check it against the insertion point.  Then using grread run the appropriate program automatically.

Sounds great in theory but how do i go about checking the X Y of the door to the X Y of the insertion point?

Thanks
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

GDF

  • Water Moccasin
  • Posts: 2081
Re: Point perpendicular to point (line)
« Reply #21 on: April 18, 2007, 02:23:49 PM »
Hey fellas

here is how the program is shaping up:  (no error checking - yet)

Now what I have thought of doing is to add a point to the door block.  Once the door is selected check for that point (It will be on the end of the door at the latch)  Get the point location and check it against the insertion point.  Then using grread run the appropriate program automatically.

Sounds great in theory but how do i go about checking the X Y of the door to the X Y of the insertion point?

Thanks

Tim

Great job...this is very similar to my routine, but your's is more elegant. Keep up the good work.
Can't wait to see your final version.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #22 on: April 18, 2007, 03:39:36 PM »
Thanks Gary,

Once I get everything worked out I will add the rest of the doors and I will olso be creating one for windows.  Before I get a bunch of code written i want to get the framework first.

I'll keep ya posted.
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

GDF

  • Water Moccasin
  • Posts: 2081
Re: Point perpendicular to point (line)
« Reply #23 on: April 18, 2007, 04:59:25 PM »
Thanks Gary,

Once I get everything worked out I will add the rest of the doors and I will olso be creating one for windows.  Before I get a bunch of code written i want to get the framework first.

I'll keep ya posted.


Tim

Here is what I have to date (plan view):

'("Single Dr"       "Double Dr"      "Egress Dr" "Veranda Dr"
      "Slider Dr"       "Pocket Dr" "Cased Opening" "Garage Dr"         "Single Wdw"      "Double Wdw"
      "Sng Wdw Shelf"     "Dbl Wdw Shelf"      "Single Lvr"
      "Double Lvr"          "Sng Lvr Shelf"      "Dbl Lvr Shelf" "Wdw Open" "Bifold Dr"
     )

With the hardest one to draw parametrically being the bifold door.

Gary







Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #24 on: April 20, 2007, 01:03:14 PM »
Ok guys,  I'm still working on this a little at a time.  My current issue is I have created a block with 2 points in it.  When I select the block and drill through it to get the 2 point I am getting the points from when they were createed relative to 0,0,0 not from where the are currently in that particular block.  How do I get there current locations?   trans??

Thanks
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
Re: Point perpendicular to point (line)
« Reply #25 on: April 23, 2007, 03:28:29 PM »
OK guys/gals,

Here are the preliminary programs,  One creates the single door and the other modifies the swing location.
The modify program will only modify the door created by the creation program (unless your doors are blocks with the same insertion point.)
Upon running the modify program your will be promted to select the door.  select the door then you're promted to select the door quadrant.  Quadrant are defined as follows:  0,0 is the door hinge point X is along the wall direction and Y is the along the door  itself.

limitations so far.:
It will only create a swing of 90 deg.
No error checking

Give it a whirl let me know what sucks and what is good.  Once I get most of the bugs worked out on this I will begin to create other door types then I will move onto windows.

Thanks
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

Onetrack

  • Guest
Re: Point perpendicular to point (line)
« Reply #26 on: July 09, 2007, 05:41:01 PM »

I have a small routine that draws a line from a point to a perpendicular then labels it with both feet and metres. I've also adapted this to be metres only (to the centimetre). I use it often for building offsets, as its very handy.

The feet/metres is attached, modify at will. I'm not the original author.

Code: [Select]
(DEFUN C:FM ( / ss f l e1 e2 dist dist2 distm distft mx mx m2 Ro r)
; e1,e2 - endpoints

(setq ht (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
(setq hta ht)
(setq htb (* -1.0 ht))

(setvar "cmdecho" 0)
(princ "\nSelect the line to Label: ")
(setq ss (ssget))
(if ss (progn
    (setq l 0)
    (setq n (sslength ss))
    (while (< l n)
 
    (SETQ f (entget (ssname ss l)))
            (SETQ e1 (CDR (ASSOC 10 f)))
            (SETQ e2 (CDR (ASSOC 11 f)))
            (SETQ DIST (DISTANCE E1 E2))
            (SETQ DIST2 (/ DIST 0.3048))
            (SETQ DIST3 (* DIST2 12.000))
            (SETQ DISTM (RTOS DIST 2 3))
            (SETQ DISTFT (RTOS DIST3 4 3))
            (SETQ DISTF (STRCAT "[" DISTFT "]"))
            (SETQ Mx (/ (+ (car e1) (car e2)) 2))   ;midpt x
            (SETQ My (/ (+ (cadr e1) (cadr e2)) 2)) ;midpt y
            (SETQ M (list Mx My)) ;midpoint

; ro - 90d offset bearing
   (setq r (* (ANGLE e1 e2) (/ 180.0 pi)))
   (setq ro r)
   (SETQ Ro (+ Ro 90.0))
   (if (and (> ro 180.0) (<= ro 360.0)) (setq ro (+ 180.0 ro)) )
   (setq ro (* ro (/ pi 180.0)))
   (SETQ R (- 90.0 R))
   (if (and (>= r -180.0) (< r 0.0)) (setq r (+ 180.0 r)) )
   (if (< r 0.0) (setq r (+ 360.0 r)) )
   (setq m2 (list (/ (+ (car e1) (car e2)) 2) (/ (+ (cadr e1) (cadr e2)) 2)))
   (command "text" "M" (polar m2 ro hta) r DISTM)
   (command "text" "M" (polar m2 ro htb) r DISTF)
   (setq l (+ 1 l)) 
   );endwhile
  );endprogn
 );endif
(princ)           
)

(defun c:SS (  / a nz n index na b d e d1 e1 h h1 b1 b2)
     (setq a (ssget))
     (setq n (sslength a))
      (setq index 0)
      (repeat n
            (setq b (entget (ssname a index)))
            (setq index (1+ index))
            (setq d (assoc 10 b))
            (setq e (assoc 11 b))
            (setq d1 (list (cadr d) (caddr d) 0));create new list
            (setq e1 (list (cadr e) (caddr e) 0));create new list
            (setq h (cons (car d) d1))
            (setq b1 (subst h d b))
            (entmod b1)
            (setq h1 (cons (car e) e1))
            (setq b2 (subst h1 e b1))
            (entmod b2)
 
       (LBL B2)

      );end repeat
  (prin1)
)