Rectangle to shape

Recommended Posts

I hope I can explain properly what I would like to do.

I need to be able to click on an entity and draw a rectangle between two opposing entities but have the ends of the rectangle follow the angle of the two opposing entities.

For example if I have an entity and two apposing vertical/horizontal entities I would click the line, infinity line or sometimes polyline side then be prompted for the rectangle width and have it terminate at the two opposing entities and have the smaller sides at the angle of those entities.

I hope I'm making sense?

Tom

• Replies 25
• Created

• 10

• 4

• 4

• 3

Posted Images

upload a sample drawing.

Edited by mhupp
Share on other sites

Hope this works.....

Edited by Tom Matson
Share on other sites

It will be more accurate to select the two lines on the two sides to create the rectangle within than specifying two points to have the rectangle drawn with respect to the desired gap & angle of corners.

Share on other sites

5 hours ago, Tom Matson said:

Hope this works.....

```(defun c:drawoffset ()
(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:"))))
end2 (reverse(cdr(reverse(getpoint "\nSelect second endpoint:"))))
offset (getint "\n Offset distance:")
pt1 (list (car end1) (- (last end1) offset))
pt2 (list (car end1) (+ (last end1) offset))
pt4 (list (car end2) (- (last end2) offset))
pt3 (list (car end2) (+ (last end2) offset))
)

(command "line" pt1 pt2 "")
(command "line" pt2 pt3 "")
(command "line" pt3 pt4 "")
(command "line" pt4 pt1 "")

)```

Will work for the supplied drawing.  If anyone can improve this code I'd be interested in seeing it, as I am still learning autolisp.

Share on other sites

Select green line select 2 blues lines, use intersectwith to get intersecting points and work out the new 4 points. Look at image as an example. BIt short for time at moment.

Share on other sites

@TemporaryCAD That worked nicely!

@BIGAL That is closer to what I'm trying to do. I'll look into the intersectwith function, I like the offset option. Then maybe use intersectwith from those offsets.

I use the other label routine you helped me with every day!

Share on other sites

The width should't be measured in vertical, but perpendicular to line end1-end2.

You have also to divide into two since you are adding that distance upwards and downwards.

Your code would look more or less like this:

```(defun c:yourprog()
(setq end1 (getpoint "\nSelect first endpoint: ")
end2 (getpoint "\nSelect second endpoint: ")
width (getreal "\nWidth: ")
vertical (/ width (cos (angle end1 end2)) 2)
pt1 (list (car end1) (- (cadr end1) vertical))
pt2 (list (car end2) (- (cadr end2) vertical))
pt3 (list (car end2) (+ (cadr end2) vertical))
pt4 (list (car end1) (+ (cadr end1) vertical))
)
(command "_line" pt1 pt2 pt3 pt4 pt1 "")
)```

But I think Tom's entities may not be vertical. That was only an example. The code could be more or less like this:

```(defun c:try()
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 512)
(setq sel1 (entsel "Entidad1"))
(setq ent1 (car sel1))
(setq end1 (vlax-curve-getClosestPointTo ent1 (cadr sel1)))
(setq sel2 (entsel "Entidad2"))
(setq ent2 (car sel2))
(setq end2 (vlax-curve-getClosestPointTo ent2 (cadr sel2)))
(setvar "osmode" 0)
(setq width (getreal "\nWidth: "))
;
(setq alpha (angle end1 end2))
;
(setq nearend1 (polar end1 alpha 0.001))
(setq alin12 (vlax-curve-getClosestPointTo ent1 nearend1))
(setq beta (angle end1 alin12))
(if (> beta pi) (setq beta (- beta pi)))
(setq end3 (polar end1 beta (/ 2.5 (sin (- beta alpha)))))
(setq end5 (polar end1 (+ pi beta) (/ 2.5 (sin (- beta alpha)))))
;
(setq nearend2 (polar end2 (+ pi alpha) 0.001))
(setq alin22 (vlax-curve-getClosestPointTo ent2 nearend2))
(setq gamma (angle end2 alin22))
(if (> gamma pi) (setq gamma (- gamma pi)))
(setq end4 (polar end2 gamma (/ 2.5 (sin (- gamma alpha)))))
(setq end6 (polar end2 (+ pi gamma) (/ 2.5 (sin (- gamma alpha)))))
;

(command "_line" end3 end4 end6 end5 end3 "")
(setvar "osmode" oldsnap)
)```

Share on other sites

@Jamescalabut You are correct the wont always be vertical.

Your code is very close to what I'm trying to do, but I need to snap. sometimes it's an intersection sometimes it's an endpoint etc.

in @TemporaryCAD 's routine I can getpoint and I've been looking at how @BIGAL suggested using "intersectwith" with the offsets.

I just can't make heads or tails on a "projected" intersection.

But so far yours comes closest, if I could just snap 2 points, offset, then find intersections from that offset I think it would do the trick??

Share on other sites

```(defun c:try()
;(setq oldsnap (getvar "osmode"))
;(setvar "osmode" 512)
(setq sel1 (entsel "Entidad1"))
(setq ent1 (car sel1))
;(setq end1 (vlax-curve-getClosestPointTo ent1 (cadr sel1)))
;(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:")))))
(setq sel2 (entsel "Entidad2"))
(setq ent2 (car sel2))
;(setq end2 (vlax-curve-getClosestPointTo ent2 (cadr sel2)))
(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:")))))
(setq end2 (reverse(cdr(reverse(getpoint "\nSelect second endpoint:")))))

;(setvar "osmode" 0)
(setq width (getreal "\nWidth: "))
;
(setq alpha (angle end1 end2))
;
(setq nearend1 (polar end1 alpha 0.001))
(setq alin12 (vlax-curve-getClosestPointTo ent1 nearend1))
(setq beta (angle end1 alin12))
(if (> beta pi) (setq beta (- beta pi)))
(setq end3 (polar end1 beta (/ 2.5 (sin (- beta alpha)))))
(setq end5 (polar end1 (+ pi beta) (/ 2.5 (sin (- beta alpha)))))
;
(setq nearend2 (polar end2 (+ pi alpha) 0.001))
(setq alin22 (vlax-curve-getClosestPointTo ent2 nearend2))
(setq gamma (angle end2 alin22))
(if (> gamma pi) (setq gamma (- gamma pi)))
(setq end4 (polar end2 gamma (/ 2.5 (sin (- gamma alpha)))))
(setq end6 (polar end2 (+ pi gamma) (/ 2.5 (sin (- gamma alpha)))))
;

(command "_line" end3 end4 end6 end5 end3 "")
;(setvar "osmode" oldsnap)
)```

I combined the two and this code works!

I still have to select the "vertical" entities then pick the first and last points but I think I can make this work.....

I took out the snap overrides. will that have a significant or unpredictable result down the line? but right now it seems to get me there.

Share on other sites

Also, this routine offsets from a centerline, which is exactly what I need. But I also need one to offset to one side of the selected points.

I'm going to try to modify to do that too as a separate routine....any suggestions?

Share on other sites

@Jamescalabut after working with it for a little bit, I noticed that it throws a dividing by zero error for parallel lines?

Also, It works well if the new rectangle end points are ON the opposing entities. But if I select the ENDS of the entity it doesn't follow correctly?

I tried a couple of things but broke it....lol

Here is the newest modified routine (not broken), I added a polyline entity instead of separate lines. Credit for the polyline routine goes to another member, just can't find the thread.

```;; draws a polyline
(defun drawLWPoly (lst cls ang bl tl br tr)
(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))))

(defun c:try()
;(setq oldsnap (getvar "osmode"))
;(setvar "osmode" 512)
(setq sel1 (entsel "Entidad1"))
(setq ent1 (car sel1))
;(setq end1 (vlax-curve-getClosestPointTo ent1 (cadr sel1)))
;(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:")))))
(setq sel2 (entsel "Entidad2"))
(setq ent2 (car sel2))
;(setq end2 (vlax-curve-getClosestPointTo ent2 (cadr sel2)))
(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:")))))
(setq end2 (reverse(cdr(reverse(getpoint "\nSelect second endpoint:")))))

;(setvar "osmode" 0)
(setq width (getreal "\nWidth: "))
(setq width (/ width 2))
;
(setq alpha (angle end1 end2))
;
(setq nearend1 (polar end1 alpha 0.001))
(setq alin12 (vlax-curve-getClosestPointTo ent1 nearend1))
(setq beta (angle end1 alin12))
(if (> beta pi) (setq beta (- beta pi)))
(setq end3 (polar end1 beta (/ width (sin (- beta alpha)))))
(setq end5 (polar end1 (+ pi beta) (/ width (sin (- beta alpha)))))
;
(setq nearend2 (polar end2 (+ pi alpha) 0.001))
(setq alin22 (vlax-curve-getClosestPointTo ent2 nearend2))
(setq gamma (angle end2 alin22))
(if (> gamma pi) (setq gamma (- gamma pi)))
(setq end4 (polar end2 gamma (/ width (sin (- gamma alpha)))))
(setq end6 (polar end2 (+ pi gamma) (/ width (sin (- gamma alpha)))))
;

;(command "_line" end3 end4 end6 end5 end3 "")
(drawLWPoly (list end3 end4 end6 end5) 1)
;(setvar "osmode" oldsnap)
)```

Share on other sites

Try this one. First, select the "boundary" rectangle, then specify offset distance, and finally select the "green" line at where you want the shape to be created:

```(defun c:test ( / ang ang1 ang2 bnd end1 end2 ent i int ln off ppt pt1 pt2 pt3 pt4 pts ss)
(and
(princ "\nSelect boundary objects.")
(setq bnd (ssget '((0 . "LINE,LWPOLYLINE"))))       ;; Prompt user for selection of the boundary
(setq off (getdist "\nSpecify offset distance <exit>: "))   ;; Prompt for offset distance
(repeat (setq i (sslength bnd))  ;; Convert selection set into a list of VLA-Objects to be compatible with IntersectWith function.
(setq i (1- i) ss (cons (vlax-ename->vla-object (ssname bnd i)) ss))
)
(setq off (* off 0.5))  ;; Multiply by 0.5 to offset half the distance.
(while  ;; Prompt user for curve selection  (the post assumes that the user only works with a straight line for the "rectangle")
(progn
(setvar "errno" 0)
(initget "Exit")
(setq ent (entsel "\nSelect line to offset [Exit] <exit>: "))
(cond
(   (= (getvar "errno") 7) (princ "\nNothing selected."))
(   (member ent '("Exit" nil)) nil)
(   (not (wcmatch (cdr (assoc 0 (entget (setq ln (car ent))))) "LINE"))
(princ "\nObject is not a line")
)
(   (progn  ;; Start to calculate intersection points. This is the automated process of prompting the two points by selecting a single line instead
(setq ln (vlax-ename->vla-object ln) pts nil)
(foreach crv ss
(if (setq int (vlax-invoke ln 'IntersectWith crv acextendnone))
(repeat (/ (length int) 3)
(setq pts (cons (list (car int) (cadr int) (caddr int)) pts) int (cdddr int))
)
)
)
(not pts)
)
(princ "\nNo intersection points found.")
)
(   (progn
;; To obtain the two points, we can make use of the second argument of entsel (the location of the pickpoint) and calculate if
;; it resides between any two of the intersection points calculated above.

;; Step 1 - Obtain the "parameter" of the curve at each calculated point.
(setq pts (mapcar '(lambda (a) (list a (vlax-curve-getparamatpoint ln a))) pts))

;; Step 2 - Sort the parameters in ascending order.
(setq pts (vl-sort pts '(lambda (a b) (< (cadr a) (cadr b)))))

;; Step 3 - Calculate the parameter of the curve at the picked point
(setq ppt (vlax-curve-getparamatpoint ln (vlax-curve-getclosestpointto ln (trans (cadr ent) 1 0)))) ;; trans to make it work in all UCS.

;; Step 4 - Find out if the pick point is in between any of the two points.
(not
(vl-some
(function
(lambda (p1 p2)
(if (< (cadr p1) ppt (cadr p2))
(setq end1 (car p1) end2 (car p2))
)
)
)
pts
(cdr pts)
)
)
)
(princ "\nLocation does not reside between calculated intersection points.")
)
(   t

;; Step 5: Obtain the angle of the "boundary" polyline at the intersection point.
(vl-some
(function
(lambda (crv / cl)
(if (equal end1 (setq cl (vlax-curve-getclosestpointto crv end1)) 1e-8)
(setq ang1 (angle '(0 0 0) (vlax-curve-getfirstderiv crv (vlax-curve-getparamatpoint crv cl))))
)
)
)
ss
)
(vl-some
(function
(lambda (crv / cl)
(if (equal end2 (setq cl (vlax-curve-getclosestpointto crv end2)) 1e-8)
(setq ang2 (angle '(0 0 0) (vlax-curve-getfirstderiv crv (vlax-curve-getparamatpoint crv cl))))
)
)
)
ss
)

;; Step 6 - Perform calculations:
;;  end1 - First endpoint of intersection
;;  end2 - Second endpoint of intersection
;;  ang1 - The angle of the line at the first boundary point
;;  ang2 - The angle of the line at the second boundary point
;;  off  - Offset Width

(setq ang (+ (angle end1 end2) (* pi 0.5))
pt1 (polar end1 ang off)
pt2 (polar end2 ang off)
pt3 (polar end1 ang (* off -1))
pt4 (polar end2 ang (* off -1))
pt1 (inters pt1 pt2 end1 (polar end1 ang1 1) nil)
pt2 (inters pt1 pt2 end2 (polar end2 ang2 1) nil)
pt3 (inters pt3 pt4 end1 (polar end1 ang1 1) nil)
pt4 (inters pt3 pt4 end2 (polar end2 ang2 1) nil)
)

;; Step 7 - Draw the lines.
(foreach x
(list
(list pt1 pt2)
(list pt2 pt4)
(list pt4 pt3)
(list pt3 pt1)
)
(entmake (list '(0 . "LINE") (cons 10 (car x)) (cons 11 (cadr x))))
)
)
)
)
)
)
(princ)
)```

Share on other sites

On 8/2/2022 at 2:34 AM, TemporaryCAD said:
```(defun c:drawoffset ()
(setq end1 (reverse(cdr(reverse(getpoint "\nSelect first endpoint:"))))
end2 (reverse(cdr(reverse(getpoint "\nSelect second endpoint:"))))
offset (getint "\n Offset distance:")
pt1 (list (car end1) (- (last end1) offset))
pt2 (list (car end1) (+ (last end1) offset))
pt4 (list (car end2) (- (last end2) offset))
pt3 (list (car end2) (+ (last end2) offset))
)

(command "line" pt1 pt2 "")
(command "line" pt2 pt3 "")
(command "line" pt3 pt4 "")
(command "line" pt4 pt1 "")

)```

Will work for the supplied drawing.  If anyone can improve this code I'd be interested in seeing it, as I am still learning autolisp.

For learners, that's quite good. Here's some things that I can find in your code that you may improve:

1. Instead of using "getint", use "getdist" because you're prompting for distance. With "getdist", the user has the option to not only enter the number denoting the distance, but can also otherwise specify by clicking two points somewhere on the drawing to represent the distance. It's more flexible this way.
2. When using (command), remember that snaps play a role which may sometimes lead to inaccuracies. You may wish to disable it like (command "_line" "_non" pt1 "_non" pt2 "")
3. On "end2", you can write (getpoint end1 "\nSelect second endpoint:") to create a ribbon line from the first pick point.
4. Always remember to localise variables. You do so in the beginning: (defun c:drawoffset ( / end1 end2 offset pt1 pt2 pt3 pt4)
Share on other sites

Nice work Jonathan.

I thought the line would be picked by Tom, as he said it could be an intersection or an end point.

If the entities could have angles, then the polygon would be up to 6 sides (using the intersection ponts of the center line also).

I continued with my programme and, not being very good at VLA (in fact, not good  at too many things) I had to repeat four timesthe same routine finding the correct intersection point as I discovered I got ALL the intersection points of each entity and offsetted line.

Can anybody show me a simpler way to find those points (lines 20,21,22 and three more times)?

Thank you.

```(defun c:try2()
(setq oldsnap (getvar "osmode"))
(setq ent1 (vlax-ename->vla-object (car(entsel "\nSelect first entity: "))))
(setq ent2 (vlax-ename->vla-object (car(entsel "\nSelect second entity: "))))
(setq p1 (getpoint "point on the first entity: "))
(setq p2 (getpoint "point on the second entity: "))
(setq alpha (angle p1 p2))
(setq width (getreal "\nWidth: "))
(setvar "osmode" 0)
(entmake (list '(0 . "LINE") (list 10 (car p1) (cadr p1) 0) (list 11 (car p2) (cadr p2) 0) '(210 0.0 0.0 1.0)))
(setq line1 (entlast))
(setq vlaobject-line1 (vlax-ename->vla-object line1))
(setq p3 (polar p1 (- alpha (/ pi 2)) (/ width 2)))
(setq p4 (polar p1 (+ alpha (/ pi 2)) (/ width 2)))
(command "_offset" "_t" line1 p3 "")
(setq line2 (entlast))
(setq vlaobject-line2 (vlax-ename->vla-object line2))
(setq int1 (vlax-safearray->list (vlax-variant-value (vla-IntersectWith ent1 vlaobject-line2 acExtendboth))))
(setq k1 (list (car int1) (cadr int1) (caddr int1)))
(setq k2 (list (caddr (reverse int1)) (cadr (reverse int1)) (car (reverse int1))))
(if (> (distance p1 k1) (distance p1 k2)) (setq int1 k2) (setq int1 k1))
(setq int2 (vlax-safearray->list (vlax-variant-value (vla-IntersectWith ent2 vlaobject-line2 acExtendboth))))
(setq k1 (list (car int2) (cadr int2) (caddr int2)))
(setq k2 (list (caddr (reverse int2)) (cadr (reverse int2)) (car (reverse int2))))
(if (> (distance p2 k1) (distance p2 k2)) (setq int2 k2) (setq int2 k1))
(command "_offset" "_t" line1 p4 "")
(setq line3 (entlast))
(setq vlaobject-line3 (vlax-ename->vla-object line3))
(setq int3 (vlax-safearray->list (vlax-variant-value (vla-IntersectWith ent1 vlaobject-line3 acExtendboth))))
(setq k1 (list (car int3) (cadr int3) (caddr int3)))
(setq k2 (list (caddr (reverse int3)) (cadr (reverse int3)) (car (reverse int3))))
(if (> (distance p1 k1) (distance p1 k2)) (setq int3 k2) (setq int3 k1))
(setq int4 (vlax-safearray->list (vlax-variant-value (vla-IntersectWith ent2 vlaobject-line3 acExtendboth))))
(setq k1 (list (car int4) (cadr int4) (caddr int4)))
(setq k2 (list (caddr (reverse int4)) (cadr (reverse int4)) (car (reverse int4))))
(if (> (distance p2 k1) (distance p2 k2)) (setq int4 k2) (setq int4 k1))
(command "_line" int1 int2 p2 int4 int3 p1 int1 "")
(entdel line1) (entdel line2) (entdel line3)
)```

Share on other sites

@Jamescalabut If I were to create a program, I'd rather have the code do all the complex calculations and have the command made as user-friendly as possible. The less you prompt the user for inputs, the better. But for learning purposes, any progress is definitely worth every effort you put

Just as you said, IntersectWith finds out ALL intersection points of a line, and peforming the calculations are quite hard. If you were already prompting the user for the point instead of the curve, you've basically skipped to Step 5 of my code. Another approach you can do is: You already have p1 and p3. If you have (for example p5 which represents the same calculation from p2), then you can use the inters function to calculate the intersecting point of 4 points (like Step 6 of my code), being p3, p5, p1, and (polar p1 <the angle of the curve at p1> <any_length>). Though still, no matter what approach is taken, the process still needs to be repeated four times to get the four points required to draw the curve and this.

I've tried adjusting some parts of your code to make it simpler. It should still function the same way as your original code:

```(defun c:try2( / alpha ent1 ent2 int1 int2 int3 int4 k1 k2 line1 line2 line3 oldsnap p1 p2 vlaobject-line1 vlaobject-line2 vlaobject-line3 width)
(setq oldsnap (getvar "osmode"))
(setq p1 (getpoint "point on the first entity: "))
(setq p2 (getpoint p1 "point on the second entity: "))      ;; Add p1 to create a ribbon line to the first point when prompting the second point
(setq ent1 (vlax-ename->vla-object (car (nentselp p1))))    ;; Use nentselp for automatic selection of the polyline using a picked point
(setq ent2 (vlax-ename->vla-object (car (nentselp p2))))    ;; Use nentselp for automatic selection of the polyline using a picked point
(setq alpha (angle p1 p2))
(setq width (getdist "\nWidth: "))  ;; Changed to getdist for better flexibility of distance input.
(setvar "osmode" 0)
(setq line1 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) '(210 0.0 0.0 1.0))))   ;; Use 'entmakex' to return the generated entity instead of entlast.
(setq vlaobject-line1 (vlax-ename->vla-object line1))
(setq vlaobject-line2 (car (vlax-safearray->list (vlax-variant-value (vla-Offset vlaobject-line1 (/ width 2))))))      ;; Use Vla-Offset to get your offset line by distance
(setq vlaobject-line3 (car (vlax-safearray->list (vlax-variant-value (vla-Offset vlaobject-line1 (/ width -2))))))     ;; Use Vla-Offset to get your offset line by distance
(mapcar     ;; You can use mapcar instead... I guess
'(lambda (a / k1 k2 v)
(set (car a) (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (cadr a) (caddr a) acExtendboth))))
(setq v (eval (car a)))
(setq k1 (list (car v) (cadr v) (caddr v)))
(setq k2 (list (caddr (reverse v)) (cadr (reverse v)) (car (reverse v))))
(if (> (distance (cadddr a) k1) (distance (cadddr a) k2)) (set (car a) k2) (set (car a) k1))
)
(list
(list 'int1 ent1 vlaobject-line2 p1)
(list 'int2 ent2 vlaobject-line2 p2)
(list 'int3 ent1 vlaobject-line3 p1)
(list 'int4 ent2 vlaobject-line3 p2)
)
)
(command "_line" int1 int2 p2 int4 int3 p1 int1 "")
(vla-delete vlaobject-line1) (vla-delete vlaobject-line2) (vla-delete vlaobject-line3)
(setvar "osmode" oldsnap)   ;; Set snap variable back.
)```

Share on other sites

@Jonathan Handojo That works Very nicely! very simple to use.

One thing I like about this site is how helpful everyone is. Like you said, any progress is worth it.

I've learned a lot more by studying other peoples code, some of these routines are pretty involved!

Can you modify that routine to also offset to one side instead of centerline?

When I click the end of the two entities, the two picked points become one side of the rectangle, the offset could then intersect with the two entities and create my rectangle.

I need both routines, I draw a lot of designs with center supports and supports at the ends.

At the ends, the supports are always captured between the two entities.

Thanks Again

Share on other sites

@Tom Matson Maybe give this one a go. Same process as the previous command, but after clicking on the centerline, simply move your mouse to either side of the curve, or have your cursor near the curve for the center, and click to place:

```(defun c:test (/ ang ang1 ang2 bnd col end1 end2 ent gr grp grv i int ln off ppt pt1 pt2 pt3 pt4 pts ss tmp)
(and
(princ "\nSelect boundary objects.")
(setq bnd (ssget '((0 . "LINE,LWPOLYLINE"))))       ;; Prompt user for selection of the boundary
(setq off (getdist "\nSpecify offset distance <exit>: "))   ;; Prompt for offset distance
(repeat (setq i (sslength bnd))  ;; Convert selection set into a list of VLA-Objects to be compatible with IntersectWith function.
(setq i (1- i) ss (cons (vlax-ename->vla-object (ssname bnd i)) ss))
)
(setq off (* off 0.5)           ;; Multiply by 0.5 to offset half the distance.
col (getvar "cecolor")    ;; Get current entity color for visual purposes
)
(cond
(   (= col "BYLAYER")   ;; If current entity colour is by layer, find colour of layer.
(setq col (abs (cdr (assoc 62 (tblsearch "layer" (getvar "clayer")))))) ;; 'abs' to return positive value. Negative value indicates that the layer is locked.
)
(   (= col "BYBLOCK") (setq col 7)) ;; If by block, set colour to white
(   (setq col (atoi col)))  ;; Else, set colour to the current entity colour.
)
(while  ;; Prompt user for curve selection  (the post assumes that the user only works with a straight line for the "rectangle")
(progn
(setvar "errno" 0)
(initget "Exit")
(setq ent (entsel "\nSelect line to offset [Exit] <exit>: "))
(cond
(   (= (getvar "errno") 7) (princ "\nNothing selected."))
(   (member ent '("Exit" nil)) nil)
(   (not (wcmatch (cdr (assoc 0 (entget (setq ln (car ent))))) "LINE"))
(princ "\nObject is not a line")
)
(   (progn  ;; Start to calculate intersection points. This is the automated process of prompting the two points by selecting a single line instead
(setq ln (vlax-ename->vla-object ln) pts nil)
(foreach crv ss
(if (setq int (vlax-invoke ln 'IntersectWith crv acextendnone))
(repeat (/ (length int) 3)
(setq pts (cons (list (car int) (cadr int) (caddr int)) pts) int (cdddr int))
)
)
)
(not pts)
)
(princ "\nNo intersection points found.")
)
(   (progn
;; To obtain the two points, we can make use of the second argument of entsel (the location of the pickpoint) and calculate if
;; it resides between any two of the intersection points calculated above.

;; Step 1 - Obtain the "parameter" of the curve at each calculated point.
(setq pts (mapcar '(lambda (a) (list a (vlax-curve-getparamatpoint ln (vlax-curve-getclosestpointto ln a)))) pts))

;; Step 2 - Sort the parameters in ascending order.
(setq pts (vl-sort pts '(lambda (a b) (< (cadr a) (cadr b)))))

;; Step 3 - Calculate the parameter of the curve at the picked point
(setq ppt (vlax-curve-getparamatpoint ln (vlax-curve-getclosestpointto ln (trans (cadr ent) 1 0)))) ;; trans to make it work in all UCS.

;; Step 4 - Find out if the pick point is in between any of the two points.
(not
(vl-some
(function
(lambda (p1 p2)
(if (< (cadr p1) ppt (cadr p2))
(setq end1 (car p1) end2 (car p2))
)
)
)
pts
(cdr pts)
)
)
)
(princ "\nLocation does not reside between calculated intersection points.")
)
(   t

;; Step 5: Obtain the angle of the "boundary" polyline at the intersection point.

(vl-some
(function
(lambda (crv / cl)
(if (equal end1 (setq cl (vlax-curve-getclosestpointto crv end1)) 1e-8)
(setq ang1 (angle '(0 0 0) (vlax-curve-getfirstderiv crv (vlax-curve-getparamatpoint crv cl))))
)
)
)
ss
)
(vl-some
(function
(lambda (crv / cl)
(if (equal end2 (setq cl (vlax-curve-getclosestpointto crv end2)) 1e-8)
(setq ang2 (angle '(0 0 0) (vlax-curve-getfirstderiv crv (vlax-curve-getparamatpoint crv cl))))
)
)
)
ss
)

;; Step 6 - Perform calculations:
;;  end1 - First endpoint of intersection
;;  end2 - Second endpoint of intersection
;;  ang1 - The angle of the line at the first boundary point
;;  ang2 - The angle of the line at the second boundary point
;;  off  - Offset Width

(setq ang (rem (+ (angle end1 end2) (* pi 0.5)) (+ pi pi)))
(princ "\nSpecify location to place offset [Exit] <exit>: ")
(while
(progn
(setq
gr (grread t 15 0)  ;; This obtains computer input depending on mouse movement or keyboard press.
grv (car gr)
)
(redraw)
(cond
(   (member grv '(5 3))     ;; This indicates either mouse movement or mouse click.
(cond
(   (equal  ;; This condition checks if the cursor is somewhere along the line (equaling the offset distance)
(setq grp (trans grp 1 0))  ;; 'grp' on mouse movement or click indicates the location of the cursor.
(setq tmp (inters end1 end2 grp (polar grp ang 1) nil))
off
)
(setq pt1 (polar end1 ang off)
pt2 (polar end2 ang off)
pt3 (polar end1 ang (* off -1))
pt4 (polar end2 ang (* off -1))
pt1 (inters pt1 pt2 end1 (polar end1 ang1 1) nil)
pt2 (inters pt1 pt2 end2 (polar end2 ang2 1) nil)
pt3 (inters pt3 pt4 end1 (polar end1 ang1 1) nil)
pt4 (inters pt3 pt4 end2 (polar end2 ang2 1) nil)
)
)
(   (equal ang (angle tmp grp) 1e-8)    ;; This condition checks if the cursor is residing on one side of the line.
(setq pt1 end1
pt2 end2
pt3 (polar end1 ang (* off 2))
pt4 (polar end2 ang (* off 2))
pt3 (inters pt3 pt4 end1 (polar end1 ang1 1) nil)
pt4 (inters pt3 pt4 end2 (polar end2 ang2 1) nil)
)
)
(   (setq pt1 end1                      ;; Otherwise this means the cursor is on the other side of the line.
pt2 end2
pt3 (polar end1 ang (* off -2))
pt4 (polar end2 ang (* off -2))
pt3 (inters pt3 pt4 end1 (polar end1 ang1 1) nil)
pt4 (inters pt3 pt4 end2 (polar end2 ang2 1) nil)
)
)
)
(grvecs ;; Perform a visual line to display the user where the lines will be drawn. (This is not an actual line, it's for visual purposes.)
(list col pt1 pt2 pt2 pt4 pt4 pt3 pt3 pt1)
'(
(1.0 0.0 0.0 0.0)
(0.0 1.0 0.0 0.0)
(0.0 0.0 1.0 0.0)
(0.0 0.0 0.0 1.0)
)
)
(cond
(   (= grv 5))
(   t   ;; This indicates a mouse click.
;; Step 7 - Draw the lines.
(foreach x
(list
(list pt1 pt2)
(list pt2 pt4)
(list pt4 pt3)
(list pt3 pt1)
)
(entmake (list '(0 . "LINE") (cons 10 (car x)) (cons 11 (cadr x))))
)
(redraw)
)
)
)
(   (= grv 2)
(cond
(   (member grp '(13 32 69 101)) (redraw))     ;; Denotes a keyboard press. Checks if 'Enter', 'Space', or 'E' is pressed.
(   t   )
)
)
(   (= grv 25)  ;; This indicates right click.
(redraw)
)
(   t   )
)
)
)
(= grv 3)   ;; If the user clicks to place, return t to continue the while loop and prompt user for input.
)
)
)
)
)
(princ)
)```

Edited by Jonathan Handojo
Share on other sites

Thank you very much. You have been very helpful.

Share on other sites

Thank you everyone,

This is the second routine I cobbled together from all the suggestions.

It is for an offset rectangle and it works only one direction,(L to R at the bottom of the entities and R to L at the top) which I'm ok with.

My question now is about the snaps....

For this routine I only need the end of the entities, that I turn on.

I thought it stored the current snap settings and then restores them but that doesn't work.

Also, if I'm zoomed out too far things go haywire....lol

Any Ideas?

```;; draws a polyline
(defun drawLWPoly (lst cls ang bl tl br tr);
(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))))
;PCRTS For Perimeter Click Rect To Shape
(defun c:PCRTS( / alpha ent1 ent2 int1 int2 int3 int4 k1 k2 line1 line2 line3 oldsnap p1 p2 vlaobject-line1 vlaobject-line2 vlaobject-line3 width)
(setq oldsnap (getvar "osmode"))
(setq width (getdist "\nWidth: "))  ;; Changed to getdist for better flexibility of distance input.
(while
(setvar "osmode" 1 )
(setq p1 (getpoint "point on the first entity: "))
(setq p2 (getpoint p1 "point on the second entity: "))
;; Add p1 to create a ribbon line to the first point when prompting the second point
(setq ent1 (vlax-ename->vla-object (car (nentselp p1))))    ;; Use nentselp for automatic selection of the polyline using a picked point
(setq ent2 (vlax-ename->vla-object (car (nentselp p2))))    ;; Use nentselp for automatic selection of the polyline using a picked point
(setq alpha (angle p1 p2))
;(setq width (getdist "\nWidth: "))  ;; Changed to getdist for better flexibility of distance input.

(setq line1 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2) '(210 0.0 0.0 1.0))))   ;; Use 'entmakex' to return the generated entity instead of entlast.
(setq vlaobject-line1 (vlax-ename->vla-object line1))
;(setq vlaobject-line2 (car (vlax-safearray->list (vlax-variant-value (vla-Offset vlaobject-line1 (/ width 2))))))      ;; Use Vla-Offset to get your offset line by distance
(setq vlaobject-line2 (car (vlax-safearray->list (vlax-variant-value (vla-Offset vlaobject-line1  width )))))      ;; Use Vla-Offset to get your offset line by distance
;(setq vlaobject-line3 (car (vlax-safearray->list (vlax-variant-value (vla-Offset vlaobject-line1 (/ width -2))))))     ;; Use Vla-Offset to get your offset line by distance
(mapcar     ;; You can use mapcar instead... I guess
'(lambda (a / k1 k2 v)
(set (car a) (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (cadr a) (caddr a) acExtendboth))))
(setq v (eval (car a)))
(setq k1 (list (car v) (cadr v) (caddr v)))
(setq k2 (list (caddr (reverse v)) (cadr (reverse v)) (car (reverse v))))
(if (> (distance (cadddr a) k1) (distance (cadddr a) k2)) (set (car a) k2) (set (car a) k1))
)
(list
(list 'int1 ent1 vlaobject-line2 p1)
(list 'int2 ent2 vlaobject-line2 p2)
;(list 'int3 ent1 vlaobject-line3 p1)
;(list 'int4 ent2 vlaobject-line3 p2)
(list 'int3 ent1 vlaobject-line1 p1)
(list 'int4 ent2 vlaobject-line1 p2)
)
)
;(command "_line" int1 int2 p2 int4 int3 p1 int1 "")
;(drawLWPoly (list end3 end4 end6 end5) 1)
(drawLWPoly (list int1 int2 int4 int3) 1)
(vla-delete vlaobject-line1) (vla-delete vlaobject-line2) ;(vla-delete vlaobject-line3)
(princ)
)
(setvar "osmode" oldsnap)   ;; Set snap variable back.
)```

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

Only 75 emoji are allowed.