create rectangle perpendicular to building using points as reference

[allanbsteven]

HI There,

A tough one i just cant figure out.

I want to create a rectangle (survey windows on a house) by picking the survey points near the builing line. (See attached).

I want to select first point, then second. Then have the rectangle 0.1 wide. rectangle has be be perpendicular to points and to building.

Is this possible is lisp?

I have attached what I would like to see in lisp. DWG in 2007 format, I use 2014.

Thanks for any help its much appreciated.

Regards

Allan

[marko_ribar · Accepted solution]

Hi Allan, try this code, it won't work for entities not parallel to WCS... Assuming you're using WCS by default...

(defun c:rect ( / ss p1 p2 w r1 r2 r3 r4 r31 r32 r41 r42 p )

  (vl-load-com)

  (prompt "\nSelect LINE or POLYLINE")
  (while 
    (or
      (not
        (setq ss (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE"))))
      )
      (not
        (vlax-curve-isplanar (ssname ss 0))
      )
      (not
        (or
          (equal (vlax-safearray->list (vlax-variant-value (vla-get-normal (vlax-ename->vla-object (ssname ss 0))))) '(0.0 0.0 1.0) 1e-8)
          (equal (vlax-safearray->list (vlax-variant-value (vla-get-normal (vlax-ename->vla-object (ssname ss 0))))) '(0.0 0.0 -1.0) 1e-8)
        )
      )
    )
    (prompt "\nInvalid selection of polyline or line, or entity isn't planar, or entity isn't parallel to WCS")
  )
  (while (not (setq p1 (getpoint "\nPick or specify first point : ")))
    (prompt "\nInvalid point specification, try again...")
  )
  (while (not (setq p2 (getpoint "\nPick or specify second point : ")))
    (prompt "\nInvalid point specification, try again...")
  )
  (initget 6)
  (setq w (getreal "\nSpecify width of rectangle <0.1> : "))
  (if (null w) (setq w 0.1))
  (setq r1 (vlax-curve-getclosestpointto (ssname ss 0) p1)
        r2 (vlax-curve-getclosestpointto (ssname ss 0) p2)
        r31 (polar r1 (+ (angle r1 r2) (* 0.5 pi)) w)
        r41 (polar r2 (+ (angle r1 r2) (* 0.5 pi)) w)
        r32 (polar r1 (- (angle r1 r2) (* 0.5 pi)) w)
        r42 (polar r2 (- (angle r1 r2) (* 0.5 pi)) w)
  )
  (while (not (setq p (getpoint "\nPick side to place rectangle")))
    (prompt "\nInvalid point specification, try again...")
  )
  (if (< (distance p r31) (distance p r32))
    (setq r3 r31 r4 r41)
    (setq r3 r32 r4 r42)
  )
  (command "_.pline" "_non" r1 "_non" r3 "_non" r4 "_non" r2 "_C")
  (princ)
)

 M.R.

[allanbsteven]

Thankyou so very much! Awesome stuff!!!
Much appreciated.
Cheers
Allan

[Anonymous]

Hi Marko,

Very nice Code.
Can you please explain why we need "_+." in the following expression?
(ssget "_+.:E:S" '((0 . "*POLYLINE,LINE")))
Without "_+." is also working. I am asking just for curiosity.

Thanks

[marko_ribar]

That prefix "_+.:E:S" is undocumented parameter of (ssget) function - in my documentation it says that this is used to imitate (entsel) function... Look for Selection Set handling page on www.lee-mac.com ... I think you should find this parameter (mode)... In addition to my previously posted code, I wrote one that will work in UCS rather than just WCS... So here is it - not much different, but I think better and more applicable...

(defun c:rect ( / ss p1 p2 w r1 r2 r3 r4 r31 r32 r41 r42 p )

  (vl-load-com)

  (prompt "\nSelect LINE or POLYLINE")
  (while 
    (or
      (not
        (setq ss (ssget "_+.:E:S" '((0 . "*POLYLINE,LINE"))))
      )
      (not
        (vlax-curve-isplanar (ssname ss 0))
      )
      (not
        (cond
          ( (eq (cdr (assoc 0 (entget (ssname ss 0)))) "LINE")
            (and
              (equal (caddr (trans (vlax-curve-getstartpoint (ssname ss 0)) 0 1)) 0.0 1e-8)
              (equal (caddr (trans (vlax-curve-getendpoint (ssname ss 0)) 0 1)) 0.0 1e-8)
            )
          )
          ( (wcmatch (cdr (assoc 0 (entget (ssname ss 0)))) "*POLYLINE")
            (and
              (equal (caddr (trans (vlax-curve-getpointatparam (ssname ss 0) 0.0) 0 1)) 0.0 1e-8)
              (equal (caddr (trans (vlax-curve-getpointatparam (ssname ss 0) 1.0) 0 1)) 0.0 1e-8)
              (if (vlax-curve-getpointatparam (ssname ss 0) 2.0)
                (equal (caddr (trans (vlax-curve-getpointatparam (ssname ss 0) 2.0) 0 1)) 0.0 1e-8)
                t
              )
            )
          )
        )
      )
    )
    (prompt "\nInvalid selection of polyline or line, or entity isn't planar, or entity isn't parallel to UCS")
  )
  (while (not (setq p1 (getpoint "\nPick or specify first point : ")))
    (prompt "\nInvalid point specification, try again...")
  )
  (while (not (setq p2 (getpoint "\nPick or specify second point : ")))
    (prompt "\nInvalid point specification, try again...")
  )
  (initget 6)
  (setq w (getreal "\nSpecify width of rectangle <0.1> : "))
  (if (null w) (setq w 0.1))
  (setq r1 (trans (vlax-curve-getclosestpointto (ssname ss 0) (trans p1 1 0)) 0 1)
        r2 (trans (vlax-curve-getclosestpointto (ssname ss 0) (trans p2 1 0)) 0 1)
        r31 (polar r1 (+ (angle r1 r2) (* 0.5 pi)) w)
        r41 (polar r2 (+ (angle r1 r2) (* 0.5 pi)) w)
        r32 (polar r1 (- (angle r1 r2) (* 0.5 pi)) w)
        r42 (polar r2 (- (angle r1 r2) (* 0.5 pi)) w)
  )
  (while (not (setq p (getpoint "\nPick side to place rectangle")))
    (prompt "\nInvalid point specification, try again...")
  )
  (if (< (distance p r31) (distance p r32))
    (setq r3 r31 r4 r41)
    (setq r3 r32 r4 r42)
  )
  (command "_.pline" "_non" r1 "_non" r3 "_non" r4 "_non" r2 "_C")
  (princ)
)

 Regards, M.R.