(sqrt (/ expectedArea currentArea)).
But in theory you can create a lisp that scales the polyline using this factor:
Code: [Select]
(sqrt (/ expectedArea currentArea)).
(setq differencePercent (* (/ (- 2517.90 2517.0) 2517.0) 100.0)) ; => 0.0357569 percent
What are we talking about. Aren't these tolerances normal in topography?
lol
(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)
)
(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)
)
- 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.
< .. > when I use the code for the area above 4.000mē. But to small area work perfect.
Must enter UNDO END to go back further