0 Members and 1 Guest are viewing this topic.
(defun vk_PutCoordinate (p i c) (vlax-put-property p "Coordinate" i (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length c))) c)) ))(if (setq Polyline (entsel "\nLWPolyline: ")) (progn (princ "OK\n") (setq Point (reverse (cdr (reverse (cadr Polyline)))) Polyline (vlax-ename->vla-object (car Polyline)) ) (setq Index (fix (vlax-curve-getparamatpoint Polyline (vlax-curve-getclosestpointto Polyline Point))) Index (list Index (rem (1+ Index) (fix (vlax-curve-getendparam Polyline)))) Coord (mapcar (function (lambda (i) (vlax-safearray->list (vlax-variant-value (vlax-get-property Polyline "Coordinate" i)))) ) Index ) ) (while (cond ((not (setq Input (grread t 12 0)))) ((= (car Input) 5) (setq Vect (mapcar '- (cadr Input) Point)) (mapcar (function (lambda (i c) (vk_PutCoordinate Polyline i (mapcar '+ Vect c)))) Index Coord) (princ (strcat "\r" (rtos (vlax-get-property Polyline "Area") 2) " ")) ) ((= (car Input) 25) (mapcar (function (lambda (i c) (vk_PutCoordinate Polyline i c))) Index Coord) nil ) ((= (car Input) 3) nil) (t) ) ) ))
(defun c:stretch-vertex-dyn-area&len ( / putcoordinate car-sort makenumblst c es p coords coord index input vect ) (vl-load-com) (defun putcoordinate ( curve i c ) (cond ( (vlax-property-available-p curve 'coordinates) (vla-put-coordinate curve i (vlax-3d-point c)) ) ( (vlax-property-available-p curve 'fitpoints) (vla-setfitpoint curve i (vlax-3d-point c)) ) ) ) (defun car-sort ( l f / removenth r k ) (defun removenth ( l n / k ) (setq k -1) (vl-remove-if '(lambda ( x ) (= (setq k (1+ k)) n)) l) ) (setq k -1) (vl-some '(lambda ( a ) (setq k (1+ k)) (if (vl-every '(lambda ( x ) (apply f (list a x))) (removenth l k)) (setq r a))) l) r ) (defun makenumblst ( n / k l ) (setq k -1) (repeat n (setq l (cons (setq k (1+ k)) l)) ) (reverse l) ) (while (or (not (setq c (car (setq es (entsel "\nPick curve near stretching vertex..."))))) (if c (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendpoint (list c))))) (prompt "\nMissed or picked wrong entity type...") ) (setq p (vlax-curve-getclosestpointto c (cadr es))) (cond ( (vlax-property-available-p (vlax-ename->vla-object c) 'coordinates) (if (= (length (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) 0)))) 3) (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c))))) 3)))) (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-get-coordinate (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-coordinates (vlax-ename->vla-object c))))) 2)))) ) ) ( (vlax-property-available-p (vlax-ename->vla-object c) 'fitpoints) (setq coords (mapcar '(lambda ( i ) (safearray-value (variant-value (vla-getfitpoint (vlax-ename->vla-object c) i)))) (makenumblst (/ (length (safearray-value (variant-value (vla-get-fitpoints (vlax-ename->vla-object c))))) 3)))) ) ) (setq coord (car-sort coords '(lambda ( a b ) (<= (distance p a) (distance p b))))) (if (and (equal coord (car coords) 1e-6) (equal coord (last coords) 1e-6)) (setq index (list 0 (1- (length coords)))) (setq index (list (vl-position coord coords))) ) (while (cond ( (not (setq input (grread t 12 0))) ) ( (= (car input) 5) (setq vect (mapcar '- (cadr input) (cadr es))) (mapcar '(lambda ( i ) (putcoordinate (vlax-ename->vla-object c) i (mapcar '+ vect coord))) index) (if (vlax-property-available-p (vlax-ename->vla-object c) 'Area) (princ (strcat "\nArea : " (rtos (vlax-get-property (vlax-ename->vla-object c) "Area") 2 50))) ) (if (vlax-property-available-p (vlax-ename->vla-object c) 'Area) (princ (strcat "\tLength : " (rtos (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 2 50))) (princ (strcat "\nLength : " (rtos (vlax-curve-getdistatparam c (vlax-curve-getendparam c)) 2 50))) ) ) ( (= (car Input) 3) nil ) ) ) (princ))
This is a good starthttp://www.lee-mac.com/areastofield.html
Whilst lots have answered but not the poster, like the CIV3d advice enter the area required via the method and the solution is drawn automatically. Trying to drag a point will drive you nuts. There is a mathmatical solution for area for random points so you can reverse engineer the solution provide an area and picked point will move. I have been using this type of software solution for over 30 years. Yes its not free. Anyway I have a swing line example posted at cadtutor. I realised there was a better mathmatical way so never finished it.