TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: pedroantonio on March 08, 2014, 02:43:49 PM

Title: Adjust the area of a polygon
Post by: pedroantonio on March 08, 2014, 02:43:49 PM
Good evening. I am looking for a lisp file that fixes the size polygon.
I designed the polygon knowing the lengths of sides and its area. But  at the end the area is not the same.
Look the attach *.dwg
Thanks
Title: Re: Adjust the area of a polygon
Post by: roy_043 on March 09, 2014, 03:44:48 AM
If I look at the green rectangle in your drawing I notice that the long sides are not exactly parallel and one is 165.90 long and the other is 165.93. Both short sides are 30.00. The conclusion must be that this is not an exact rectangle. The question is then: Why is 4977.00 the correct area?

Don't you typically need measurements for multiple diagonals to accurately draw these land parcels?

But in theory you can create a lisp that scales the polyline using this factor:
Code: [Select]
(sqrt (/ expectedArea currentArea)).
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 04:19:08 AM
the dimensions and the area of ​​the polygon I get from PLANNING.
Quote
But in theory you can create a lisp that scales the polyline using this factor:
Code: [Select]
(sqrt (/ expectedArea currentArea)).

Yes but if i scale the polygon the dimensions will be change.I don't want to change the dimensions.I need the polygon to have the dimension I give and the area I give.
For example a lisp
1) Select a close polyline
2) Give the area of the polygon
Then adjust the polygon (Keep the dimensions)
Something like mapcheck but with specific area
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 09, 2014, 10:04:13 AM
pedro,

You are trying to adjust area by changing polygon angles, with no reference angles to begin with, there can be multiple solutions to this....After looking at your drawing, you realize that by doing this you will be affecting the area of any adjoining lot, you will be opening up pandora's box...
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 12:35:06 PM
Yes snownut2 you are right but i was thinking a lisp

1) Select a close polyline
2) Give the area of the polygon
3)Select the point  (one or two points to change the angle)

Then adjust the polygon (Keep the dimensions)
Something like mapcheck but with specific area

What do you think ? I think this way is better .
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 09, 2014, 12:40:50 PM
Pedro,

Think about that, you need to adjust every single angle to maintain the line lengths, not just one or two.

Bruce
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 12:47:50 PM
Not exactly . If i want to change point 2 ,i need to select point 1 ,point2,point3
look the dwg
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 09, 2014, 01:22:12 PM
Maybe I was a little dramatic when I said every single angle, however I still stand that you need to adjust multiple (many) angles to maintain the line lengths.  (on lots with only a few lot lines it will be all angles).

In your sample drawing, the angle prior to pt1 along with pt1, pt2 & pt3 angles would all be affected by making any area change.

Affecting 4 out of 6 angles, and affecting the area of the abutting lot to the rear.

Title: Re: Adjust the area of a polygon
Post by: mailmaverick on March 09, 2014, 01:35:44 PM
Dear Friend,

I did some research and found that there are multiple solutions to your problem.

There can be multiple combinations of 6 sided polyons with length of sides given by you and area also as given by you.

As an example, I am attaching DWG file in which I have made three 6 sides polygons with each side as given by you and area also as given by you.

You can see that apart from these three, there are even more multiple solutions.

Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 01:41:42 PM
yes but if i chose only  one angle to be change  like point1,point2,point3 not all the angles , it will change only the angle in the point 2
Title: Re: Adjust the area of a polygon
Post by: roy_043 on March 09, 2014, 02:02:06 PM
Isn't this really a case of rounding?
2517.12 ("wrong"); Rounded: 2517 ("correct").
4977.33 ("wrong"); Rounded: 4977 ("correct").
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 02:04:15 PM
yes but in same othe option you will have a bigger difference for example

2517.12 ---->2517.90 or 2519.30 etc
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 09, 2014, 02:06:57 PM
Pedro,

Why don't you try drawing a new lot configuration with a new area by adjusting the angle @ pt2 ONLY, keeping all line lengths are they are then post result here, that way we can understand exactly what it is you are after.

If as in Roy's post it is caused by rounding, instead of using an "=" sign in the comparison statement use  "equal" with a fuzz factor. 

Code - Auto/Visual Lisp: [Select]
  1. (if (equal area1 area2 0.1)
  2.    (carry on)
  3. )
  4.  


Bruce 
Title: Re: Adjust the area of a polygon
Post by: roy_043 on March 09, 2014, 02:12:30 PM
Code: [Select]
(setq differencePercent (* (/ (- 2517.90 2517.0) 2517.0) 100.0)) ; => 0.0357569 percentWhat are we talking about. Aren't these tolerances normal in topography?
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 09, 2014, 02:33:12 PM
yes it is. just i ask for it.I understand that is not possible to make a lisp to fix it. Thank you gays..
Title: Re: Adjust the area of a polygon
Post by: MP on March 09, 2014, 03:46:12 PM
lol
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 09, 2014, 04:25:25 PM
Quote from: MP on March 09, 2014, 03:46:12 PM
lol

you're a sport... 8-)
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 10, 2014, 06:00:17 AM
Hello, this is my first post and I need your help. I am looking for a program in which the user selects a polyline, writes the desired area, then selects some vertices on that polyline and the program will stretch the selected vertices until the desired area is achieved. Can this be done?
Title: Re: Adjust the area of a polygon
Post by: mailmaverick on March 11, 2014, 03:06:45 AM
Hello Vladgothe

I dont think such a LISP is possible because there would be unlimited combinations of each vertex to be stretched.

Title: Re: Adjust the area of a polygon
Post by: ribarm on March 11, 2014, 05:31:26 AM
I would suggest rather simple code as Roy proposed - scaling instead of stretching...

Code: [Select]
(defun c:scf ( / ent ea len nlen cir ncir are nare vol nvol ch sf bp )
  (vl-load-com)
  (setq ent (car (entsel "\nPick entity for scaling")))
  (if (vlax-property-available-p (setq ea (vlax-ename->vla-object ent)) 'Length)
    (setq len (vla-get-length ea))
    (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ea)))) (setq len (- (vlax-curve-getdistatparam ea (vlax-curve-getendparam ea)) (vlax-curve-getdistatparam ea (vlax-curve-getstartparam ea)))))
  )
  (if (vlax-property-available-p ea 'Circumference)
    (setq cir (vla-get-circumference ea))
  )
  (if (vlax-property-available-p ea 'Area)
    (setq are (vla-get-area ea))
  )
  (if (vlax-property-available-p ea 'Volume)
    (setq vol (vla-get-volume ea))
  )
  (prompt "\nChoose current parameter to adjust while scaling : 1.Length = ") (princ len) (prompt "; 2.Circumference = ") (princ cir) (prompt "; 3.Area = ") (princ are) (prompt "; 4.Volume = ") (princ vol) (prompt " : ")
  (initget "1 2 3 4")
  (setq ch (getkword))
  (cond
    ( (eq ch "1")
      (initget 7)
      (setq nlen (getreal "\nSpecify desired Length : "))
      (setq sf (/ nlen len))
    )
    ( (eq ch "2")
      (initget 7)
      (setq ncir (getreal "\nSpecify desired Circumference : "))
      (setq sf (/ ncir cir))
    )
    ( (eq ch "3")
      (initget 7)
      (setq nare (getreal "\nSpecify desired Area : "))
      (setq sf (expt (/ nare are) (/ 1.0 2.0)))
    )
    ( (eq ch "4")
      (initget 7)
      (setq nvol (getreal "\nSpecify desired Volume : "))
      (setq sf (expt (/ nvol vol) (/ 1.0 3.0)))
    )
  )
  (setq bp (getpoint "\nPick base point for scale by factor for desired parameter : "))
  (vla-scaleentity ea (vlax-3d-point bp) sf)
  (princ)
)
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 11, 2014, 12:04:24 PM
Thank you ribarm. I already made a program which scales a polyline using the centroid, but this is good too.I tried to make myself a program, but it gives me an error and I don't know why. It will help me very much if you can help me to get rid of that error. Here is the code:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:ms ()
  2. (setvar "CMDECHO" 0)
  3. (command "undo" "begin")
  4. (setq os_old (getvar "OSMODE"))
  5. (setvar "OSMODE" 1)
  6. (setq lista '())
  7. (setq obj (car (entsel "\nSelecteaza conturul: ")))
  8. (while (not obj)
  9. (setq obj (car (entsel "\nSelecteaza conturul: ")))
  10. )
  11. (if (wcmatch (cdr (assoc 0 (entget obj))) "*POLYLINE")
  13. ;;facem lista cu coordonatele
  14. (foreach x (setq e (entget obj))
  15.         (if (= 10 (car x)) (setq l (cons (cdr x) l)))
  16.     )
  17. (vla-put-closed (vlax-ename->vla-object obj) :vlax-true)       
  18. (setq arieinitiala (vla-get-Area (vlax-ename->vla-object obj)))
  19. (initget (+ 1 2 4))
  20. (setq ariedor (getreal (strcat "\nScrieti suprafata la care doriti sa ajungeti <" (rtos arieinitiala 2 2) "mp> ")))
  21. ;;daca aria dorita este egala cu aria initiala
  22. (if (= (rtos ariedor 2 0) (rtos arieinitiala 2 0))
  23. (alert "\nAti ales aceeasi arie cu cea a conturului!")
  26. (setq pt (getpoint "\nAlegeti punctele din care se modifica suprafata: "))
  27. (setq xpt (car pt))
  28. (setq ypt (cadr pt))
  29. (if (not (member (list xpt ypt) l))
  30. (alert "\nPunctul trebuie sa fie un vertex al conturului!")
  31. (setq lista (append (list (list xpt ypt)) lista))
  32. )
  33. )
  34. (setq lista (reverse lista))
  35. (setq lista (LI_MakeUnique lista))
  36. (mapcar '(lambda (x) (= 0.01 x)) '(offset1 offset2 offset3 offset4 offset5 offset6 offset7 offset8 offset9 offset10 offset11 offset12 offset13 offset14 offset15))
  37. (setq arieobj arieinitiala)
  38. ;;Cazul 1
  39. ;;Aria dorita este mai mica decat aria initiala
  41. ((< ariedor arieinitiala)
  42. (while (< ariedor arieinitiala)
  43. (foreach item lista
  44. (setq xprev (car (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1- (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  45. (setq yprev (cadr (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1- (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  46. (setq xnext (car (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1+ (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  47. (setq ynext (cadr (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1+ (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  49. ((and (or (<= xprev (car item))  (>= xprev (car item))) (>= xnext (car item)) (>= ynext (cadr item)) (<= yprev (cadr item)))
  50. (command "stretch" "c" item item "" item (list (+ (car item) offset1) (cadr item)))
  51. (setq offset1 (+ 0.01 offset1))
  52. )
  53. ((and (or (<= xprev (car item)) (>= xprev (car item))) (>= xnext (car item)) (>= ynext (cadr item))  (>= yprev (cadr item)))
  54. (command "stretch" "c" item item "" item (list (car item) (+ (cadr item) offset2)))
  55. (setq offset2 (+ 0.01 offset2))
  56. )
  57. ((and (>= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  58. (command "stretch" "c" item item "" item (list (- (car item) offset3) (cadr item)))
  59. (setq offset3 (+ offset 0.01))
  60. )
  61. ((and (>= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  62. (command "stretch" "c" item item "" item (list (car item) (- (cadr item) offset4)))
  63. (setq offset4 (+ offset4 0.01))
  64. )
  65. ((and (>= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  66. (command "stretch" "c" item item "" item (list (+ (car item) offset5) (- (cadr item) offset5)))
  67. (setq offset5 (+ offset5 0.01))
  68. )
  69. ((and (>= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  70. (command "stretch" "c" item item "" item (list (+ (car item) offset6) (cadr item)))
  71. (setq offset6 (+ offset7 0.01))
  72. )
  73. ((and (<= xnext (car item)) (>= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  74. (command "stretch" "c" item item "" item (list (- (car item) offset8) (cadr item)))
  75. (setq offset7 (+ offset7 0.01))
  76. )
  77. ((and (<= xnext (car item)) (>= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  78. (command "stretch" "c" item item "" item (list (- (car item) offset8) (+ (cadr item) offset8)))
  79. (setq offset8 (+ offset8 0.01))
  80. )
  81. ((and (<= xnext (car item)) (>= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  82. (command "stretch" "c" item item "" item (list (+ (car item) offset9) (+ (cadr item) offset9)))
  83. (setq offset9 (+ offset9 0.01))
  84. )
  85. ((and (<= xnext (car item)) (>= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  86. (command "stretch" "c" item item "" item (list (car item) (+ (cadr item) offset10)))
  87. (setq offset10 (+ offset10 0.01))
  88. )
  89. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  90. (command "stretch" "c" item item "" item (list (- (car item) offset11) (- (cadr item) offset11)))
  91. (setq offset11 (+ offset11 0.01))
  92. )
  93. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  94. (command "stretch" "c" item item "" item (list (+ (car item) offset12) (cadr item)))
  95. (setq offset12 (+ offset12 0.01))
  96. )
  97. ((and (<= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  98. (command "stretch" "c" item item "" item (list (+ (car item) offset13) (- (cadr item) offset13)))
  99. (setq offset13 (+ offset13 0.01))
  100. )
  101. ((and (<= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  102. (command "stretch" "c" item item "" item (list (car item) (- (cadr item) offset14)))
  103. (setq offset14 (+ offset14 0.01))
  104. )
  105. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  106. (command "stretch" "c" item item "" item (list (- (car item) offset15) (- (cadr item) offset15)))
  107. (setq offset15 (+ offset15 0.01))
  108. )
  109. (T nil)
  110. )
  111. )
  112. )
  113. )
  114. ((> ariedor arieinitiala)
  115. (while (> ariedor arieinitiala)
  116. (foreach item lista
  117. ;;verificam daca e si pct de start selectat
  118. (setq xnext (car (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1+ (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  119. (setq ynext (cadr (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1+ (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  120. (setq xprev (car (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1- (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  121. (setq yprev (cadr (vlax-curve-getPointAtParam (vlax-ename->vla-object obj) (1- (vlax-curve-getParamAtPoint (vlax-ename->vla-object obj) item)))))
  123. ((and (>= xnext (car item)) (>= ynext (cadr item)) (or (<= xprev (car item))  (>= xprev (car item))) (<= yprev (cadr item)))
  124. (command "stretch" "c" item item "" item (list (- (car item) offset1) (cadr item)))
  125. (setq offset1 (+ 0.01 offset1))
  126. )
  127. ((and (>= xnext (car item)) (>= ynext (cadr item)) (or (<= xprev (car item)) (>= xprev (car item))) (>= yprev (cadr item)))
  128. (command "stretch" "c" item item "" item (list (car item) (- (cadr item) offset2)))
  129. (setq offset2 (+ 0.01 offset2))
  130. )
  131. ((and (>= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  132. (command "stretch" "c" item item "" item (list (+ (car item) offset3) (cadr item)))
  133. (setq offset3 (+ offset 0.01))
  134. )
  135. ((and (>= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  136. (command "stretch" "c" item item "" item (list (car item) (+ (cadr item) offset4)))
  137. (setq offset4 (+ offset4 0.01))
  138. )
  139. ((and (>= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  140. (command "stretch" "c" item item "" item (list (- (car item) offset5) (+ (cadr item) offset5)))
  141. (setq offset5 (+ offset5 0.01))
  142. )
  143. ((and (>= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  144. (command "stretch" "c" item item "" item (list (- (car item) offset6) (cadr item)))
  145. (setq offset6 (+ offset7 0.01))
  146. )
  147. ((and (<= xnext (car item)) (>= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  148. (command "stretch" "c" item item "" item (list (+ (car item) offset8) (cadr item)))
  149. (setq offset7 (+ offset7 0.01))
  150. )
  151. ((and (<= xnext (car item)) (>= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  152. (command "stretch" "c" item item "" item (list (+ (car item) offset8) (+ (cadr item) offset8)))
  153. (setq offset8 (+ offset8 0.01))
  154. )
  155. ((and (<= xnext (car item)) (>= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  156. (command "stretch" "c" item item "" item (list (- (car item) 0.01) (- (cadr item) 0.01)))
  157. (alert "Asta e mo!")
  158. (setq offset9 (+ offset9 0.01))
  159. )
  160. ((and (<= xnext (car item)) (>= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  161. (command "stretch" "c" item item "" item (list (car item) (- (cadr item) offset10)))
  162. (setq offset10 (+ offset10 0.01))
  163. )
  164. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  165. (command "stretch" "c" item item "" item (list (+ (car item) offset11) (+ (cadr item) offset11)))
  166. (setq offset11 (+ offset11 0.01))
  167. )
  168. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (>= yprev (cadr item)))
  169. (command "stretch" "c" item item "" item (list (- (car item) offset12) (cadr item)))
  170. (setq offset12 (+ offset12 0.01))
  171. )
  172. ((and (<= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (>= yprev (cadr item)))
  173. (command "stretch" "c" item item "" item (list (- (car item) offset13) (+ (cadr item) offset13)))
  174. (setq offset13 (+ offset13 0.01))
  175. )
  176. ((and (<= xnext (car item)) (<= ynext (cadr item)) (>= xprev (car item)) (<= yprev (cadr item)))
  177. (command "stretch" "c" item item "" item (list (car item) (+ (cadr item) offset14)))
  178. (setq offset14 (+ offset14 0.01))
  179. )
  180. ((and (<= xnext (car item)) (<= ynext (cadr item)) (<= xprev (car item)) (<= yprev (cadr item)))
  181. (command "stretch" "c" item item "" item (list (+ (car item) offset15) (+ (cadr item) offset15)))
  182. (setq offset15 (+ offset15 0.01))
  183. )
  184. (T nil)
  185. )
  186. )
  187. )
  188. )
  189. (T nil)
  190. )
  191. )
  192. )
  193. )
  194. )
  195. (command "undo" "end")
  196. (setvar "OSMODE" os_old)
  198. )
  199.  
  200. (defun LI_MakeUnique( Lst / Lst1 tmp )
  201.  
  202. (setq Lst1 '())
  203. (foreach tmp Lst
  204.         (if (not (member tmp Lst1))
  205.                 (setq Lst1 (cons tmp Lst1))
  206.         )
  207. )
  208. (reverse Lst1)
  209. )
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 11, 2014, 12:21:36 PM
Polyline can have unlimited number of vertices... How do you determine which vertices do you want to stretch to achieve desired area? Beside that you defined 15 point stretches... I would define (while) loop to pick desired vertices and then define vector by picking 2 points that will determine direction of stretching... But then again routine will have to increment stretching by some small factor until relatively correct area is reached, but it'll take time and area would be not exactly correct...
Title: Re: Adjust the area of a polygon
Post by: CAB on March 11, 2014, 12:46:46 PM
My first look at the problem and looks like two adjacent vertices need to move & four angles would change to adjust the area. (Keeping all side the same length)
My guess is that you can move the two vertices in one of two general directions and likely get the desired area.

So you will need to pick two vertices to move & the direction to move them OR use the shortest distance to determine the direction.
Title: Re: Adjust the area of a polygon
Post by: CAB on March 11, 2014, 01:06:13 PM
Looking at another polygon it looks doable.
Pick points 1 and 2 & the segment 1-2 can be moved maintaining adjacent segment lengths.
haven't looked for an algorithm to accomplish this.
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 11, 2014, 01:14:23 PM
ribarm, the routine I posted does exactly what you said, but it's not working and until now, I don't know from where that error is coming.
Cab, I don't care how the vertices are stretched because for me both solutions are fine if the desired area is achieved.
My code should do the trick, but I get an bad argument type numberp nil error.
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 11, 2014, 01:15:06 PM
Either points 1 or 2 can independently be rotated around centers of circles, so how do you know which one is right and if both are to be rotated how do you know direction of rotation?
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 11, 2014, 01:17:12 PM
vladgothe, where in the code do you specify dirction vector for stretching? - it isn't what I described...
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 11, 2014, 01:22:49 PM
In the stretch command. I'm sorry, I forgot to translate in english language. In my code, the user selects the polyline, inputs the desired area, then selects the vertices to be stretched. The rules for stretching every vertex are defined in the cond statement.
I am a beginner in lisp, so I may be wrong and that's why I need your help. If you can, I would like you to run my code and see the cause of that error.
Cab, is not necessary to preserve adjacent segments lengths, they can be modified.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 11, 2014, 02:57:56 PM
nice job ribarm

you can add two parametres

1)select polyline
2)Specify desired Length  and Specify desired area
3)Pick two points to avoid the rotation
4)calculate the polygon
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 11, 2014, 04:12:44 PM
vladgothe, here is my version... See if it can help you...

Code: [Select]
(defun c:ms ( / adoc ar d k nar osm p1 p2 pl pla pt ptlst ptt vf )
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq osm (getvar 'osmode))
  (prompt "\nPick closed POLYLINE")
  (setq pl (ssname (ssget "_+.:E:S:L" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))) 0))
  (setq ar (vla-get-area (setq pla (vlax-ename->vla-object pl))))
  (prompt "\nSpecify new desired area value - old was : ") (princ (rtos ar 2 2)) (prompt " ; - : ")
  (initget 7)
  (setq nar (getreal))
  (setvar 'osmode 1)
  (setq pt (getpoint "\nPick start vertex on POLYLINE for stretching : "))
  (while pt
    (setq ptlst (cons pt ptlst))
    (setq pt (getpoint "\nPick next vertex on POLYLINE for stretching - ENTER to finish : "))
  )
  (setq p1 (getpoint "\nPick first-start point of stretch vector direction : "))
  (setq p2 (getpoint "\nPick second-end point of stretch vector direction : "))
  (setvar 'osmode 0)
  (vla-startundomark adoc)
  (foreach pt ptlst
    (command "_.stretch" "_C" pt pt "" pt (mapcar '+ pt (mapcar '- p2 p1)))
  )
  (if (and (> nar ar) (> (vla-get-area pla) ar)) (setq vf t))
  (if (and (> nar ar) (< (vla-get-area pla) ar)) (setq vf nil))
  (if (and (< nar ar) (< (vla-get-area pla) ar)) (setq vf t))
  (if (and (< nar ar) (> (vla-get-area pla) ar)) (setq vf nil))
  (if (and (> nar ar) vf)
    (progn
      (setq k 0.0)
      (setq ptt (mapcar '/ (mapcar '- p2 p1) (list (setq d (* (distance p1 p2) 100.0)) d d)))
      (while (> nar (vla-get-area pla))
        (command "_.undo" "_B")
        (foreach pt ptlst
          (command "_.stretch" "_C" pt pt "" pt (mapcar '+ pt (mapcar '* ptt (list (setq k (1+ k)) k k))))
        )
        (vla-update pla)
      )
    )
  )
  (if (and (> nar ar) (not vf))
    (progn
      (setq k 0.0)
      (setq ptt (mapcar '/ (mapcar '- p1 p2) (list (setq d (* (distance p1 p2) 100.0)) d d)))
      (while (> nar (vla-get-area pla))
        (command "_.undo" "_B")
        (foreach pt ptlst
          (command "_.stretch" "_C" pt pt "" pt (mapcar '+ pt (mapcar '* ptt (list (setq k (1+ k)) k k))))
        )
        (vla-update pla)
      )
    )
  )
  (if (and (< nar ar) vf)
    (progn
      (setq k 0.0)
      (setq ptt (mapcar '/ (mapcar '- p2 p1) (list (setq d (* (distance p1 p2) 100.0)) d d)))
      (while (< nar (vla-get-area pla))
        (command "_.undo" "_B")
        (foreach pt ptlst
          (command "_.stretch" "_C" pt pt "" pt (mapcar '+ pt (mapcar '* ptt (list (setq k (1+ k)) k k))))
        )
        (vla-update pla)
      )
    )
  )
  (if (and (< nar ar) (not vf))
    (progn
      (setq k 0.0)
      (setq ptt (mapcar '/ (mapcar '- p1 p2) (list (setq d (* (distance p1 p2) 100.0)) d d)))
      (while (< nar (vla-get-area pla))
        (command "_.undo" "_B")
        (foreach pt ptlst
          (command "_.stretch" "_C" pt pt "" pt (mapcar '+ pt (mapcar '* ptt (list (setq k (1+ k)) k k))))
        )
        (vla-update pla)
      )
    )
  )
  (vla-endundomark adoc)
  (setvar 'osmode osm)
  (princ)
)
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 11, 2014, 05:23:15 PM
Thank you ribarm, I will test the code tomorrow. I think I found the errors in my code and I will update it too. I usually don't write the codes so bad, but I wrote it when I was at work and I had very little time at my disposal.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 11, 2014, 06:00:44 PM
I try it but is not working well ,  i think that scf.lsp is better 

ribarm if you can do this changes

1)select polyline
2)Specify desired Length  and Specify desired area
3)Pick two points to avoid the rotation
4)calculate the polygon

it will be perfect
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 11, 2014, 06:21:16 PM
Pedro,

Why don't you attempt to make some adjustments on your own, you seem to be quite capable of spotting issues with the code.  It will show the other members here that you are at least willing to try.  Who knows maybe you will learn something in the process or at least gain a greater respect for those willing to share their knowledge.

Bruce
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 12, 2014, 05:24:43 PM
For improved accuracy... Test this code :

M.R.

[EDIT : Found some mistake in amount of stretching when multiple points are selected - Tested on square and picked 2 side points to make rectangle - now distances of stretched sides of rectangle are the same - that wasn't the case, that's why I said to test the code... It was total of 2 downloads till I reattached file...]

Hope this is now all OK...
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 13, 2014, 06:17:45 AM
Reattached ms.lsp - there was little mistake when multiple points are to be stretched...

M.R.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 13, 2014, 06:26:36 AM
when i run this lisp my autocad dont respond . why ? Can you give some instractions?
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 13, 2014, 07:35:05 AM
Topographer, there was one more mistake I made while copying pieces of codes... Now is all OK; Redownload file attached now... And for instructions just follow prompts CAD asks you and be sure to pick initial vector that would be smaller for imaginary stretch than desired area (pick small vector in any case - 2 near points)...

M.R.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 13, 2014, 07:47:20 AM
I try again and my autocad crash again . I dont know
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 13, 2014, 10:06:23 AM
Marko, AutoCAD 2007 gives an error message: INTERNAL ERROR CMD UNDO 2 every time I run the lisp, then crashes. What could the problem be?
I started working on a new routine, but unfortunately I have very much work to do and I don't have time to finish it now. Maybe someone can help?
Here is the start of the routine:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:ms (/ obj arieinitiala arieobj ariedor lista lista2)
  3. (setvar "CMDECHO" 0)
  5. (setq os_old (getvar "OSMODE"))
  7. (setvar "OSMODE" 1)
  8. (setq lista '())
  9. (setq lista2 '())
  10. (setq obj (car (entsel "\nSelect a closed polyline: ")))
  11. (while (not obj)
  12. (setq obj (car (entsel "\nSelect a closed polyline: ")))
  13. )
  14. (while (not (wcmatch (cdr (assoc 0 (entget obj))) "*POLYLINE"))
  15. (alert "The selected object is not a polyline!")
  16. (setq obj (car (entsel "\nSelect a closed polyline: ")))
  17. (while (not obj)
  18. (setq obj (car (entsel "\nSelect a closed polyline: ")))
  19. )
  20. )
  21. (setq pl (vlax-ename->vla-object obj))
  22. (if (zerop (cdr (assoc 70 (entget obj))))
  23. (vla-put-closed pl :vlax-true)
  24. )
  25. ;;we make the list with polyline vertices
  26. (foreach x (setq e (entget obj))
  27.         (if (= 10 (car x)) (setq l (cons (cdr x) l)))
  28.     )  
  29. (setq arieinitiala (vla-get-Area pl))
  31. (setq ariedor (getreal (strcat "\nWrite the area you want to achieve <" (rtos arieinitiala 2 0) " sq meters> ")))
  32. ;;daca aria dorita este egala cu aria initiala
  33. (if (= (rtos ariedor 2 0) (rtos arieinitiala 2 0))
  34. (alert "\nThe selected area is equal with polyline area!")
  37. (setq pt (getpoint "\nSelect the vertex you want to be stretched: "))
  38. (setq xpt (car pt))
  39. (setq ypt (cadr pt))
  40. (if (not (member (list xpt ypt) l))
  41. (alert "\nThe selected point must be a vertex on polyline!")
  43. (setq lista (append (list (list xpt ypt)) lista))
  44. (setq dir (getpoint "\nChoose the direction you want to stretch the vertex: "))
  45. (setq xdir (car dir))
  46. (setq ydir (cadr dir))
  47. (setq lista2 (append (list (list xdir ydir)) lista2))
  48. )
  49. )
  50. )
  51. (setq lista (reverse lista))
  52. (setq lista2 (reverse lista2))
  53. (setq lista (LI_MakeUnique lista))
  54. (setq lista2 (LI_MakeUnique lista2))
  55. (setq arieobj arieinitiala)
  56. (setq cont 0)
  58. (setq offset 0)
  59. ;;here goes the code to verify area and stretch every vertex on selected directions
  60. ;;.................
  61. ;;..................
  62. )
  63. )
  65. (setvar "OSMODE" os_old)
  67. )
  68.  
  69. (defun LI_MakeUnique( Lst / Lst1 tmp )
  70.  
  71. (setq Lst1 '())
  72. (foreach tmp Lst
  73.         (if (not (member tmp Lst1))
  74.                 (setq Lst1 (cons tmp Lst1))
  75.         )
  76. )
  77. (reverse Lst1)
  78. )
  79.  
  80.  
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 13, 2014, 10:31:18 AM
vladgothe and Topographer,

It seems that you don't have luck with version of ACAD... I've tested on my machines and the oldest version I am using is A2008 on 32 bit system, and it works fine... Guess, you both should update your hardware and software... The newest version of ACAD can be found on www and it's A2014... Just remember that during installation avoid to download service pack, for you won't be able to activate it correctly...

M.R.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 13, 2014, 10:41:03 AM
i use Autocad 2012  64 bit and this lisp crash ... it starts  but  after few seconds autocad not respond
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 13, 2014, 11:07:01 AM
You are driving me nuts... I've tested the code once again on A2014 and A2012 64 bit and it's working fine... Can someone else confirm that I am not laying... It's impossible that only my ACAD's work fine... Topographer, as I said - pick closed polyline; enter desired area; pick vertices on polyline - be careful to pick only vertices (osnap will be automatically turned on to END snap) and when done right click with mouse or ENTER; pick small vector in direction you want stretch to be processed - 2 near points (must be small vector)... And that's it - you have to be patient to be sure routine finish... No crashes on my computers and no endless loops - it finishes correctly...
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 13, 2014, 11:16:00 AM
ribarm can you upload a gif to see the steps. Maybe i do something wrong.

Thanks
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 13, 2014, 11:30:11 AM
Here is the MS.gif
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 13, 2014, 12:08:59 PM
Now some some times work. Perhaps it's my fault .

thank you ribarm
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 14, 2014, 02:53:32 AM
In AutoCAD Map 3d 2014, the "UNDO" problem doesn't appear anymore. It seems that in ACAD 2007, some commands cannot be repeated for too many times. Undo and align are two of them. But compared to undo command, align can be used as a function. Some time ago, I had a lisp where I used (command "align" etc...) multiple times and AutoCAD 2007 gave the same error. I resolved the problem using (align etc....) instead of using (command "align" ....). But it's not the case for undo command. It's a software problem, not hardware, because I work on a last generation PC.
Marko, i tested your code. When the desired area is bigger than polyline area, the program works perfectly. The problem appears when the desired area is smaller than polyline area. I set the sysvar CMDECHO to 1 before running the program and I found out that, in this case, after some time, the stretch command finds 0 objects and repeats itself in an endless loop.
Can you confirm this? Maybe I am wrong.
Title: Re: Adjust the area of a polygon
Post by: vladgothe on March 14, 2014, 05:03:55 AM
I figured it out. On big polylines with many vertices or if the difference between areas is very big, the direction vector must be bigger. If you make a short distance vector, it will take forever to accomplish the task and this is why AutoCAD seems to hang. Topographer, set sysvar COORDS to 1 and when you think that AutoCAD hangs look at coordinates and you will see that they are changing. I made a few modifications on routine, but anyway, excellent work Marko! Thank you!
Title: Re: Adjust the area of a polygon
Post by: Fabricio28 on March 14, 2014, 10:03:11 AM
@ribarm
Excellent job!

That code is fantastic!  :-D

Quote
- you have to be patient to be sure routine finish... No crashes on my computers and no endless loops - it finishes correctly...
My computer crashes when I use the code for the area above 4.000mē. But to small area work perfect.

Title: Re: Adjust the area of a polygon
Post by: Kerry on March 14, 2014, 10:07:00 AM
Quote from: FABRICIO28 on March 14, 2014, 10:03:11 AM
< .. >  when I use the code for the area above 4.000mē. But to small area work perfect.

Is that four or four thousand ?
Title: Re: Adjust the area of a polygon
Post by: Fabricio28 on March 14, 2014, 11:31:00 AM
Area = 4.000
 :-D
Title: Re: Adjust the area of a polygon
Post by: Kerry on March 14, 2014, 11:39:05 AM
very amusing.
Title: Re: Adjust the area of a polygon
Post by: Fabricio28 on March 14, 2014, 12:44:52 PM
Did you try that, Kerry?
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 14, 2014, 04:53:11 PM
FABRICIO28, sorry for inconvenience, try this new version... It works and for small area values and for large, just remember to input small starting vector...

M.R.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 14, 2014, 06:28:53 PM
riban i know that you are trying hard , but this lisp still crashes .Sorry  :embarrassed:
Is not possible to make a lisp

1) giving perimetre and area
2) select only one or two sides to stretch ??
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 15, 2014, 01:20:42 AM
I've tested ms-new.lsp under A2014 x64 with Windows 7... And this lisp passed all cases - small area and large... Maybe when you update your software - hardware you'll find it very useful as now precision is even greater than it was... If you have problems and want to use it with your current computer software - hardware, try removing last pieces of code making lisp smaller and less precise... To make it more easy to see what you should do, I'll post smaller version, but I am not sure weather it'll not crash again with your current computer state...

M.R.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 03:38:06 AM
Thank you riban i know that you are trying hard , but this lisp still crashes .Sorry  :embarrassed:

I have Autocad 2012 64bit  ,win7 ultimate SP1 with all last updates 64 bit

AMD Athlon (tm) II x4  640 Prossesor 3.00 GHz
RAM 8GB
VGA   PCI  Sapphire 5570 1 GB DDR3 HDMI

I am not laying ...

First I pick two vertex of the side i want to strech.
Second I pick to vertex on the smaller side for  the Direction
Then start working ....working....working and then crash

I try another way

First I pick two vertex of the side i want to strech.
Second I pick to points inside the polygon with very small lendth for the Direction
And then start working ....working....working and then crash again

I dont know what to do ....

The scf.lsp was working fine but it was only a scale . I am searching for a lisp to adjust the area but keeping the perimetric distances.

Imagine that you want to design a specific polygon with specific dimensions and specific  area

Thanks

Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 05:14:09 AM
I Think that all the problem is in this two commands

Pick first-start point of stretch vector direction
Pick second-end point of stretch vector direction

I don't how possisble is to change this ,but if you can change it something like this

for direction

1) Pick a point (in the polygon) for smaller areas
2) Pick a point (out the polygon) for bigger areas

Thanks
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 15, 2014, 07:57:10 AM
I think that problem doesn't lie in vector - it always have to be small and it's not important if it's inside or outside of polygon - it can even be on the polygon (I used this to stretch square to rectangle and picked vector on one side of square - just used nearest snap with 2 near points)... The problem is in functionality of your ACADs - on my netbook Windows XP 32bit A2008 and A2009, I had problem with endless looping when used ms-new.lsp with 40K, but when used ms-new.lsp I last posted it's all OK, just little more waiting to finish routine and result isn't so precise... But on my working PC Windows 7 64bit A2012 A2014 8GB RAM the best routine - ms-new.lsp 40K worked fine and really quick and result is almost exact error is on >10 decimal depends on picked vector and type of polygon routine is applied to... I don't know what to say, I am also not laying - you have to believe me, new gif is unneccessary, it'll already show already posted result only when (vl-load-com); (rtos (vla-get-area (vlax-ename->vla-object (car (entsel)))) 2 50) applied on resulting polygon it'll show how precise operation of stretching through routine actually was...
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 15, 2014, 08:57:28 AM
As a matter a fact, here is the proof... Test was made under A2012 on system shown on SYSTEM.jpg...
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 11:56:10 AM
Working only for small polygons. I try to use 90 sqm  and works fine then i try to use 9000 sqm  or  60000 sqm and crash.
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 12:10:59 PM
I don't know if this help , but when the autocad crass write in the command line this

Quote
Must enter UNDO END to go back further
Title: Re: Adjust the area of a polygon
Post by: ribarm on March 15, 2014, 12:40:52 PM
It doesn't crash on my A2012... Make sure stretch is visible on screen...
Title: Re: Adjust the area of a polygon
Post by: snownut2 on March 15, 2014, 01:40:40 PM
pedro,

Not to sound stupid but is your polyline/polygon closed ie; are you ending the last line by typing "C", or are you trying to just click on the endpoint..
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 01:48:39 PM
if it is not close the lisp didnt start any way
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on March 15, 2014, 01:58:41 PM
Here is the crash
Title: Re: Adjust the area of a polygon
Post by: pedroantonio on April 11, 2014, 11:43:24 AM
ribarm your lisp work perfect. My Autocad was the problem.I use autocad 2010 now and your lisp work fine
Title: Re: Adjust the area of a polygon
Post by: MORITZK on April 12, 2014, 05:19:42 AM
Hallo, Ribarm
your code unfortunately not works with bricscad V14. Itīs an endless loop with only the first stretch and without errors.
I think, bricscad not regen the screen before (vla-get-area ...).
Moritz