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

0 Members and 1 Guest are viewing this topic.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
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  :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
ACA 2015 - Windows 7 Pro
All Comments and Content by TimSpangler, Copyright © 2016

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
Please support this web site.

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
Please support this web site.

gile

  • Gator
  • Posts: 2507
  • 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
  • CAD Naked!!
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 TempBPt02
WallList TempEntList TempWallLayer TempWallStart TempWallEnd SelPtList
OppWall 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 :roll:
« Last Edit: April 09, 2007, 12:37:35 PM by TimSpangler »
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 #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
All Comments and Content by TimSpangler, Copyright © 2016

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
Please support this web site.

gile

  • Gator
  • Posts: 2507
  • 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  :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

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
Please support this web site.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
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
All Comments and Content by TimSpangler, Copyright © 2016

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...  :-D

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
Please support this web site.

TimSpangler

  • Water Moccasin
  • Posts: 2010
  • CAD Naked!!
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
All Comments and Content by TimSpangler, Copyright © 2016