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

0 Members and 1 Guest are viewing this topic.

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### Point perpendicular to point (line)
« on: April 07, 2007, 01:30:44 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  )

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
ACA 2015 - Windows 7 Pro

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: Point perpendicular to point (line)
« Reply #1 on: April 07, 2007, 01:54:18 PM »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: Point perpendicular to point (line)
« Reply #2 on: April 07, 2007, 02:17:20 PM »
Quick & dirty.
Code: [Select]
`(defun c:getparallelpt (/ pt ent entss ss dis parlst elst elsts layfilter)  ;;  CAB  02/05/06  (defun parallel (ln1 ln2 pfuzz / ang1 ang2)    (setq ang1 (angle (cdr (assoc 10 ln1)) (cdr (assoc 11 ln1))))    (setq ang2 (angle (cdr (assoc 10 ln2)) (cdr (assoc 11 ln2))))    (or      (equal ang1 ang2 pfuzz)      ;;  Check for lines drawn in opposite directions      (equal (min ang1 ang2) (- (max ang1 ang2) pi) pfuzz)    )  )    (while    (progn      (initget 1)      (setq pt (getpoint "\nSelect a point on the a line to find parallels."))      (setq pt (list (car pt) (cadr pt))) ; 2d point      (cond        ((null (setq entss (ssget pt '((0 . "LINE")))))         (prompt "\nMissed line, try again.")         t        )        ((> (sslength entss) 1)         (prompt "\nToo many lines at that point, try again.")         t        )        ((setq ent (ssname entss 0))         nil        )      )    )  )  ;;(initget 7)  ;;(setq dis (getdist pt "\nEnter the search distance."))  ;;  set up for max wall to be 9" thick  (setq dis 9)  (setq elst (entget ent))  (setq layfilter (assoc 8 elst))  (setq ss (ssget "_C" (mapcar '(lambda (x) (+ x dis)) pt)                       (mapcar '(lambda (x) (- x dis)) pt)                       (list '(0 . "LINE") layfilter))  )  (if (and ss (> (sslength ss) 1))    (progn      (setq elsts             (mapcar 'entget                   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))      )      (foreach ent (vl-remove elst elsts)        (if (parallel elst ent 0.0001)          (setq parlst (cons (cdr (car ent)) parlst))        )      )      (if parlst        (if (> (length parlst) 1)          (prompt "\n***  To many lines parallel, Bye.")          (progn            (setq p2 (vlax-curve-getClosestPointTo (car parlst) (trans pt 1 0) [color=red]T[/color]))            (command "_point" "_non" pt)            (command "_point" "_non" p2)            p2          )        )        (prompt "\n***  No lines parallel, Bye.")      )    )    (prompt "\n***  No lines matching Layer, Bye.")  ))`
Edit: removed prompt for wall thickness
« Last Edit: April 19, 2007, 10:47:50 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: Point perpendicular to point (line)
« Reply #3 on: April 07, 2007, 03:14:00 PM »
Hi,

Here's my contribution.

Edited
It uses some subs : 'parallelp' and 'perpendicular' (which work with vector calc subs vxv and vec1) to evaluates if the lines are parallel and if the perpendicular at specified point intersects with the other line.

Code: [Select]
`;;; VXV Returns the dot product (real) of 2 vectors(defun vxv (v1 v2)  (apply '+ (mapcar '* v1 v2)));;; VEC1 Returns the single unit vector from p1 to p2(defun vec1 (p1 p2)  (if (not (equal p1 p2 1e-008))    (mapcar '(lambda (x1 x2)        (/ (- x2 x1) (distance p1 p2))      )     p1     p2    )  ));;; PERPENDICULARP Returns T if p1 p2 and p3 p4 segments are perpendicular(defun perpendicularp (p1 p2 p3 p4)  (equal (vxv (mapcar '- p1 p2) (mapcar '- p3 p4)) 0 1e-8));;; PARALLELP Returns T if p1 p2 and p3 p4 segments are parallel(defun parallelp (p1 p2 p3 p4)  (or (equal (vec1 p1 p2) (vec1 p3 p4) 1e-8)      (equal (vec1 p1 p2) (vec1 p4 p3) 1e-8)  ));;; Returns the point on line2 on the perpendicular to line1 by pt1 if line1 is parallel to line2(defun perp_pt_to_paral (line1 line2 pt1 / start eend pt2)  (if (and (parallelp   (setq start (vlax-curve-getStartPoint line1))   (setq end (vlax-curve-getEndPoint line1))   (vlax-curve-getStartPoint line2)   (vlax-curve-getEndPoint line2) ) (setq pt2 (vlax-curve-getClosestPointTo line2 pt1)) (perpendicularp start end pt1 pt2)      )    pt2  ));; Testing function(defun c:test (/ l1 p1 l2 p2)  (if (and (setq l1 (entsel "\nPick a point on first line: ")) (setq p1 (trans (osnap (cadr l1) "_nea") 1 0)) (setq l1 (car l1)) (setq l2 (car (entsel "\nSelect second line: "))) (setq p2 (perp_pt_to_paral l1 l2 p1))      )    (entmake (list '(0 . "LINE")    (cons 10 p1)    (cons 11 p2)      )    )  )  (princ))`
« Last Edit: April 07, 2007, 04:03:26 PM by gile »
Speaking English as a French Frog

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### Re: Point perpendicular to point (line)
« Reply #4 on: April 09, 2007, 12:34:43 PM »
Thanks for the coding guys, I haven't lookked at it yet, I was busy triing to figure this thing out.  This is what I came up with after my post here,  With a few tweaks this morning it seems to work although I do get a few strange situration near angled corners.

I am going to look at what you guys posted and I'll will return with my findings.

Code: [Select]
`(defun c:foo (/ BasePoint LineEntity SelectionSet) (setq OldOsmode (getvar "OSMODE")) (setvar "OSMODE" 512) (while (null (and (setq BasePoint (getpoint "\nSelect insertsion point for door: \n")) (setq SelectionSet (ssget BasePoint '((0 . "LINE")))) ) ) (princ "\nSelect insertsion point for door: \n") ) (setq LineEntity (ssname SelectionSet 0)) (setq Testpoint (GET_PERP_POINT BasePoint LineEntity)) (setvar "OSMODE" OldOsmode) (princ) )(defun GET_PERP_POINT (Point LineEnt /WallEntList WallLayer WallStart WallEnd TempPt01 TempPt02 TempBPt01 TempBPt02WallList TempEntList TempWallLayer TempWallStart TempWallEnd SelPtListOppWall OppWallStart OppWallEnd NewPoint 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) ) ) (command "_line" Point NewPoint "") NewPoint)`
--Forgot the code
« Last Edit: April 09, 2007, 12:37:35 PM by TimSpangler »
ACA 2015 - Windows 7 Pro

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### Re: Point perpendicular to point (line)
« Reply #5 on: April 09, 2007, 12:56:58 PM »
Alan - your routine works like mine, everything is fine except in and angled corner, it returns the selected point and the corner point (i'll post images)
ACA 2015 - Windows 7 Pro

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: Point perpendicular to point (line)
« Reply #6 on: April 09, 2007, 02:00:47 PM »
Are you sure you are not confusing the 'Point'?
Post a DWG if you will.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### gile

• Gator
• Posts: 2522
• Marseille, France
##### Re: Point perpendicular to point (line)
« Reply #7 on: April 09, 2007, 04:41:00 PM »
I didn't completely understand the question.

Here's a way, adapted from Tim's one. It uses a 'Fence selection' on the perpendicular at the first line from the selected point.
It evaluates if only one parallel line on the same layer is found, and if so, it get the intersection point from the ssnamex list.

I tried to keep the same variable names as in Tim's one for a better understanding.

Code: [Select]
`(defun c:foo (/      OldOsmode     BasePoint       LineEntity     SelectionSet   WallEntList       WallStart      WallEnd     WallAngle       TempSel01      TempEntList    TempWallStart       TempWallEnd    NewPointList      )  (setq OldOsmode (getvar "OSMODE"))  (setvar "OSMODE" 512)  (while    (null      (and (setq BasePoint        (getpoint "\nSelect insertsion point for door: \n") ) (setq SelectionSet (ssget BasePoint '((0 . "LINE"))))      )    )     (princ "\nSelect insertsion point for door: \n")  )  (setvar "OSMODE" OldOsmode)  (setq LineEntity  (ssname SelectionSet 0) WallEntList (entget LineEntity) WallStart   (cdr (assoc 10 WallEntList)) WallEnd     (cdr (assoc 11 WallEntList)) WallAngle   (angle (trans WallStart 0 1) (trans WallEnd 0 1))  )  (if (< 0 (sslength (setq TempSel01   (ssdel LineEntity (ssget "_F" (list   (polar BasePoint (+ WallAngle (/ pi 2)) 12.1)   (polar BasePoint (- WallAngle (/ pi 2)) 12.1) ) (list '(0 . "LINE") (assoc 8 WallEntList)) )   )    ) )      )    (progn      (foreach lst (ssnamex TempSel01) (setq TempEntList   (entget (cadr lst))       TempWallStart (trans (cdr (assoc 10 TempEntList)) 0 1)       TempWallEnd   (trans (cdr (assoc 11 TempEntList)) 0 1) ) (if (or       (equal WallAngle (angle TempWallStart TempWallEnd) 1e-9)       (equal WallAngle (angle TempWallEnd TempWallStart) 1e-9)     )   (setq NewPointList (cons (cadr (last lst)) NewPointList)) )      )      (if NewPointList (if (= 1 (length NewPointList))   (entmake (list '(0 . "LINE") (cons 10 (trans BasePoint 1 0)) (cons 11 (car NewPointList)) (assoc 8 WallEntList)    )   )   (alert "Too many lines selected") ) (alert "None parallel line selected")      )    )    (alert "None line selected")  )  (princ))`
« Last Edit: April 09, 2007, 04:42:29 PM by gile »
Speaking English as a French Frog

#### LE

• Guest
##### Re: Point perpendicular to point (line)
« Reply #8 on: April 09, 2007, 06:18:09 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  )

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

No code or help, but just to post an image showing one of my old routines in my days as a lisper...

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: Point perpendicular to point (line)
« Reply #9 on: April 09, 2007, 06:35:23 PM »
Nice to see you again Luis.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### Re: Point perpendicular to point (line)
« Reply #10 on: April 09, 2007, 06:45:53 PM »
Alan - Here is a piccy I added the perp line the 2 squares are the point returned from your code.

Luis - Now my curiosity is peaked.  care to share?
ACA 2015 - Windows 7 Pro

#### LE

• Guest
##### Re: Point perpendicular to point (line)
« Reply #11 on: April 09, 2007, 06:49:47 PM »
Luis - Now my curiosity is peaked.  care to share?

I wrote that for a client, can't give the code away, - I could not resist posting the image - sorry

I read on your signature that you use ADT, if they have tools for doors and windows... etc?

#### LE

• Guest
##### Re: Point perpendicular to point (line)
« Reply #12 on: April 09, 2007, 06:59:15 PM »
Nice to see you again Luis.

Thanks.

and yes bothering people again...

#### CAB

• Global Moderator
• Seagull
• Posts: 10401
##### Re: Point perpendicular to point (line)
« Reply #13 on: April 09, 2007, 07:02:35 PM »
Change this
(setq p2 (vlax-curve-getClosestPointTo (car parlst) (trans pt 1 0)))
to this
(setq p2 (vlax-curve-getClosestPointTo (car parlst) (trans pt 1 0) T))
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### Re: Point perpendicular to point (line)
« Reply #14 on: April 09, 2007, 07:08:23 PM »
Thanks Luis,  It's just a reminder of how much I have to learn when compare to  such greats minds (all present company included).  Yes I do use ADT but no were near it potential.

Thanks for the update Alan I'll give it a go in a few (have to go get the kids bathed)
« Last Edit: April 09, 2007, 07:10:56 PM by TimSpangler »
ACA 2015 - Windows 7 Pro

#### 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...
Well you never bothered me.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970

#### GDF

• Water Moccasin
• Posts: 2085
##### 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  )

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?

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### GDF

• Water Moccasin
• Posts: 2085
##### 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?

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### GDF

• Water Moccasin
• Posts: 2085
##### 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?

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### GDF

• Water Moccasin
• Posts: 2085
##### 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?

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### TimSpangler

• Water Moccasin
• Posts: 2010
##### 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

#### 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))`