Looking for 2 click centerline rectangle

[Abrasive]

I searched for a routine but couldn't find any. 

Looking to draw a rectangle similar to a rich line. Where I can click 2 points and draw a rectangle through the centerline. 

I use mostly 2 widths so the rectangle width would would be predetermined in the lisp routine. I will create a button to initiate the routine. 

Thanks in advance 

Tom

[Emmanuel Delay]

Yeah, sure.

 

Command TCCR.

 

I let you first enter the width.

Then, since you need that width multiple times I put the rest in a while loop.

 

Of course you can hard code the width and remove the while if you want.

 

;; degrees to rad
(defun deg2rad (deg / )
  (/ (* deg pi ) 180)
)

;; draws a polyline
(defun drawLWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))
				   
;; TCCR for: Two Click Centerline Rectangle
(defun c:TCCR ( / w ang p1 p2 bl br tl tr)
	(setq w (getreal "\nWidth: "))
	
	(while (setq p1 (getpoint "\nPoint 1:"))
		(setq p2 (getpoint "\nPoint 2:" p1))
		;; calculate bottom/left, bottom/right,... 
		(setq ang (angle p1 p2))
		
		(setq bl (polar p1 (- ang (deg2rad 90.0)) (/ w 2.0)))
		(setq tl (polar p1 (+ ang (deg2rad 90.0)) (/ w 2.0)))
		(setq br (polar p2 (- ang (deg2rad 90.0)) (/ w 2.0)))
		(setq tr (polar p2 (+ ang (deg2rad 90.0)) (/ w 2.0)))
		
		(drawLWPoly (list bl br tr tl) 1)
	)
)

 

[Abrasive]

Wow

Works perfect thanks!

Good idea to specify the width first, I didn't think about that.

Thanks Again

Tom

[BIGAL]

Are the widths fixed size if so look at my Multi radio buttons.lsp can have the sizes pre programmed.

 

(setq ans (atoi(ah:butts ahdef "V" '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))))

Multi radio buttons.lsp

Edited June 23, 2022 by BIGAL

[Abrasive]

@BIGAL

I like it.

That is what I was originally thinking.

The routine from Emmanuel gives me the option to enter the width, which I didn't realize how useful that was going to be.

Thanks

Tom

[Abrasive]

@Emmanuel Delay

Your TCCR routine works perfectly.

Could we do another one?

Where it functions the same way but it offsets the rectangle to one side of the line?

I tried modifying your code but broke it....lol

Thanks,

Tom

[Emmanuel Delay]

27 minutes ago, Tom Matson said:

@Emmanuel Delay

Your TCCR routine works perfectly.

Could we do another one?

Where it functions the same way but it offsets the rectangle to one side of the line?

I tried modifying your code but broke it....lol

Thanks,

Tom

 

I'm not sure what exactly you mean.

Could you explain it a bit further (maybe draw a sketch or so)?

[Abrasive]

Right now I'm not on the computer, but basically if I have a line or Xline I would like to click 2 points just like your other routine but instead of being centered it would be drawn to one side or the other.

It would still ask me the width of the rectangle just like it does now....

 

 

[Abrasive]

;; degrees to rad
(defun deg2rad (deg / )
  (/ (* deg pi ) 180)
)

;; draws a polyline
(defun drawLWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))
				   
;; TCCR for: Two Click Centerline Rectangle
(defun c:TCCR2 ( / w ang p1 p2 bl br tl tr)
	(setq w (getreal "\nWidth: "))
	
	(while (setq p1 (getpoint "\nPoint 1:"))
		(setq p2 (getpoint "\nPoint 2:" p1))
		;; calculate bottom/left, bottom/right,... 
		(setq ang (angle p1 p2))
		
		(setq bl p1)
		(setq tl (polar p1 (+ ang (deg2rad 90.0)) w))
		(setq br p2)
		(setq tr (polar p2 (+ ang (deg2rad 90.0)) w))
		
		(drawLWPoly (list bl br tr tl) 1)
	)
)

@Emmanuel Delay

I figured it out!!

Having your code helped quite a bit.

thanks again.

[Abrasive]

@Emmanuel DelayYour above TCCR routine has really helped a lot, I use it every day!

Here the one I modified to TCOR from yours:

;; degrees to rad
(defun deg2rad (deg / )
  (/ (* deg pi ) 180)
)

;; draws a polyline
(defun drawLWPoly (lst cls)
 (entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length lst))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) lst))))
				   
;; TCOR for: Two Click Offset Rectangle
(defun c:TCOR ( / w ang p1 p2 p3 bl br tl tr)
	(setq w (getreal "\nWidth: "))
	
	(while (setq p1 (getpoint "\nPoint 1:"))
		(setq p2 (getpoint "\nPoint 2:" p1))
		;; calculate bottom/left, bottom/right,... 
		(setq ang (angle p1 p2))
    ;ORIGINAL:
    ;(setp pt3 (polar pt2 (+ (angle pt1 pt2)  (/ pi 2)) dist))
		;(setq p3 (polar p2 (+ (angle p1 p2) (/ pi 2)) -8))
		(setq bl p1)
		(setq tl (polar p1 (+ ang (deg2rad 90.0)) w))
		(setq br p2)
		(setq tr (polar p2 (+ ang (deg2rad 90.0)) w))
		
		(drawLWPoly (list bl br tr tl) 1)
    ;(command "_.Dimaligned" p1 p2 p3)
	)
)

Is there a way to modify the TCOR so I can select one edge of a Polyline?

I'm thinking that pt1 and pt2 could be used from the selected polylines edge.

The polyline will always be closed and the offset rectangle will need to go to the inside of the shape.

I tried a couple of things but don't know how to isolate just one line from the polyline.

Thanks!

[devitg]

On 6/23/2022 at 5:12 AM, Abrasive said:

Where I can click 2 points

Would it be 2 consecutives point at the pline?

 

[Abrasive]

12 minutes ago, devitg said:

Would it be 2 consecutives point at the pline?

 

I have to click 2 points in the routine now.

What I would like to do is just click one of the polylines segments and then offset a given distance to the inside of the shape.

And yes, those points will be 2 consecutives points on the polyline.

[devitg]

27 minutes ago, Abrasive said:

What I would like to do is just click one of the polylines segments

Ok , why do you need 2 pt ?, just get the pline and offset as need 

 

[devitg]

Just as follow

 

(VL-LOAD-COM)
          (SETQ PLINE+PT (ENTSEL "\n Pick a pline side"))
          (SETQ PLINE (CAR PLINE+PT))
          (SETQ PT@PLINE (VLAX-CURVE-GETCLOSESTPOINTTO PLINE (CADR PLINE+PT)))

          (SETQ PLINE-OFF-DIST (GETDIST PT@PLINE))

          (SETQ OFF-PLINE (VLA-OFFSET (VLAX-ENAME->VLA-OBJECT PLINE) (- PLINE-OFF-DIST)))

Guess the distance is inside the pline

[Abrasive]

I need to create a rectangle from the selected polyline segment.

Sorry if I wasn't clear. The above routine (TCOR) asks me what width the rectangle is, then I pick 2 points and it draws the rectangle from that width and from one point to another.

What I need is to be able to just select a polyline segment and create that rectangle.

[devitg]

12 minutes ago, Abrasive said:

What I need is to be able to just select a polyline segment and create that rectangle.

Really I do not get understanding . 

 

Do you mean to draw a rectangle "centered" on the pline side?

Some like it?

 

 

 

[devitg]

Please Upload a sample before.dwg and after.dwg

 

[Abrasive]

DET1.bmp

[Abrasive]

[BIGAL]

You need get segment of pline, and  a check of direction CW or CCW.

 

; Pline segment with angle and length

(defun c:plseg()
(setq plent (entsel "\nSelect Pline  "))
(setvar "osmode" 0)
(setq
      pick (cadr plent)
      plObj (vlax-ename->vla-object (car plent))
      pick2 (vlax-curve-getclosestpointto plobj pick)
      param (vlax-curve-getparamatpoint plObj pick2)
      segment (fix param)
	  co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
(setq pt1 (nth segment co-ord))
(setq pt2 (nth (+ segment 1) co-ord))
(if (= pt2 nil)(setq pt2 (nth 0 co-ord)))
(setq len (distance pt1 pt2))
(setq ang (angle pt1 pt2))
(alert (strcat "angle is "  (rtos (/ (* ang 180.0) pi) 2 2) " Length is " (rtos len 2 3)))
)

 

CW or CCW

; Checking if pline is CW or CCW and set to CCW
; Orignal idea  by Kent Cooper, 1 August 2018 Offsetinorout.lsp
; By Alan H July 2020

(defun AH:chkcwccw (ent / objnew area1 area2 obj minpoint maxpoint)

(setq obj (vlax-ename->vla-object ent))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq pointmin (vlax-safearray->list minpoint))
(setq pointmax (vlax-safearray->list maxpoint))
(setq dist (/ (distance pointmin pointmax) 20.0))

(vla-offset obj dist)
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area1  (vlax-get objnew 'Area))
(vla-delete objnew)

(vla-offset obj (- dist))
(setq objnew (vlax-ename->vla-object (entlast)))
(setq area2  (vlax-get objnew 'Area))
(vla-delete objnew)

(if (> area1 area2)
  (progn
  (command "reverse" ent "") ; for Bricscad use pedit R
  (setq y (+ y 1))
  )
)
)

(defun c:CWCCW   ( / *error*  x ent oldsnap doc ss)

(setq doc (vla-get-activedocument (vlax-get-acad-object)))

(vla-startundomark doc)
(setq y 0)
(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)

(prompt (strcat "\nSelect Plines to check"))

(if (setq ss (ssget  '((0 . "*POLYLINE"))))
    (progn
      (repeat (setq x (sslength ss))
         (setq ent (ssname ss (setq x (- x 1))))
         (AH:chkcwccw ent)
      )
   )
)
(vla-endundomark doc)

(alert (strcat (rtos y 2 0) " Plines reversed"))

(setvar 'osmode oldsnap)
(princ)
)

(vl-load-com)
(prompt "\nType CWCCW to set plines to CCW")
(c:CWCCW)