lisp to scale by moving only one side

March 24, 2020

Hello everyone, I've a request for a lisp

1. which would scale a polyline to a certain area given by the user which could be bigger or smaller than original area.

2. The polyline should scale only in one direction, that is only one side of polygon/polyline should move (user would select that side).

3. The side which would move, must maintain the angle of it's two adjacent sides/lines with respect to itself.

plz look at the images below for more clarity.

Edited March 24, 2020 by xpr0

March 25, 2020

Its a iterative solution redo the pline vertices based for example on line A and C you move the points and get new area the increment would be small so area tolerance is met. I would pick the two corners, get their Vertice count then its a polar with correct angle. Don't have anything at moment but a hint add 1st vertice to verts list so forward back of 1st point can be calculated.

March 25, 2020

3 hours ago, BIGAL said:

Its a iterative solution redo the pline vertices based for example on line A and C you move the points and get new area the increment would be small so area tolerance is met. I would pick the two corners, get their Vertice count then its a polar with correct angle. Don't have anything at moment but a hint add 1st vertice to verts list so forward back of 1st point can be calculated.

Thanks for your reply bigal, but i dont know any thing about lisp writing or computer programming. I've also searched the internet for this kind of lisp and found nothing. I was hoping someone here would write this lisp for me.

March 25, 2020

It will need to be written its an old request I have software that does it when developing the lot layouts in the 1st place. Like every one need time.

March 25, 2020

30 minutes ago, BIGAL said:

It will need to be written its an old request I have software that does it when developing the lot layouts in the 1st place. Like every one need time.

Ya sure, i understand that you could do this in your spare time, i can wait. & Whats the name of that software i'll look into it.

March 26, 2020

The software was Civilcad now Magnet, but its built in to a lot of the civil packages like CIV3D, Parcel create, they have tools like swing a line, move a line which is what you want enter area required and it works it out.

Maybe google allotment creation, parcels, lots, depends on where you are in the world what they are called. There are some packages available.

Carlson comes to mind, Cadstudio ?

Edited March 26, 2020 by BIGAL

March 26, 2020

There's few possible solution,

1.as @BIGAL mentioned iterations

2.math solution (i have a 3-sides program using calculator)

3.simpson's rule but not sure..

Insert other media

March 26, 2020

Before doing some thing is the next question what about this also, The obvious is take an area and cut it into multiple areas using a method like a line brg. How many other scenarios ?

March 27, 2020

On 3/26/2020 at 10:58 AM, hanhphuc said:

There's few possible solution,

1.as @BIGAL mentioned iterations

2.math solution (i have a )

3.simpson's rule but not sure..

Insert other media

1. i dont know anything about lisp writing. so i dont know what iterations means in this context.

2. what's the "3-sides program using calculator"

March 27, 2020

On 3/26/2020 at 1:35 PM, BIGAL said:

Before doing some thing is the next question what about this also, The obvious is take an area and cut it into multiple areas using a method like a line brg. How many other scenarios ?

sorry i didnt get that what's line brg

March 28, 2020

You take an area shape and imply a line at a bearing crossing the total area, then enter area required the line is now drawn subdividing the original area with the required area (respect to a tolerance to the area)

March 28, 2020

On 3/28/2020 at 8:17 AM, BIGAL said:

You take an area shape and imply a line at a bearing crossing the total area, then enter area required the line is now drawn subdividing the original area with the required area (respect to a tolerance to the area)

IMO geometry algorithm (tips: quadrilateral area) is faster than "guessing",

but coding with iteration inters is much easier

here i have a simple concept, just pick at one segment leg then slide.

the rest you can optimize..

(defun c:aaa ( / ang en i k l p p1 ep )
  (and
    (mapcar 'set '(en p) (entsel "Pick segment on LWPOLYLINE.. "))
    (setq p1 (osnap p "nea"))
    (setq p  (trans p1 1 0)
	  i   (fix (vlax-curve-getparamatpoint en p)))
    (setq ep (vlax-curve-getEndParam en))
    (>= ep 3)
    (< 0 i (1- ep))
    (setq ang
	   (mapcar ''((x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x)))
		   (list (1- i) (1+ i))
	   )
    )
    (while
      (and p
	   (mapcar 'set '(k p) (grread t 13))
	   (= 5 k)
	   (setq p1 (trans p 1 0))
      )
       (redraw)
       (setq l
	  (mapcar ''((a b / p)
		     (list
		      (setq p (vlax-curve-getPointAtParam en b))
		      (inters p (polar p a 1.0) p1
		       (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 )
		       nil
		      )
		     )
		    )
		  ang
		(list i (1+ i))
		  
	  )
       )
       (grvecs
	 (apply	'append
		(mapcar
		  ''((x)
		     (cons (car x) (mapcar ''((x) (trans x 0 1)) (cdr x)))
		    )
		  (cons
		    (cons 2 (mapcar 'cadr l))
		    (mapcar ''((x) (cons 2 x))
			    l
		    )
		  )
		)
	 )
       )

    )

  )
  (princ)
)

Edited March 29, 2020 by hanhphuc

March 28, 2020

March 29, 2020

Found this by *Joe Burke over at Autodesk\forum this may be the way to go so can wok out the vertice point to be changed and area re-calced. You can reset a vertice co-ords without redoing all vertices.

(defun c:test ( / elst ename pt param preparam postparam)
(setq elst (entsel "\nSelect pline segment: "))
(setq ename (car elst))
(setq pt (cadr elst))
(setq pt (vlax-curve-getClosestPointTo ename pt))
(print (setq param (vlax-curve-getParamAtPoint ename pt)) )
(print (setq preparam (fix param)) )
(print (setq postparam (1+ preparam)) )
(list
(vlax-curve-getPointAtParam ename preparam)
(vlax-curve-getPointAtParam ename postparam)
)
)

Some more sample code just draw a pline. will move vertice 2 to 0,0

(setq obj (vlax-ename->vla-object (car (entsel "Pick object "))))
(setq new_coord1 (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 1)) (list 0 0))))
(vla-put-coordinate obj 2 new_coord1)
(setq area (vla-get-area obj))

March 29, 2020

20 hours ago, hanhphuc said:

IMO geometry algorithm (tips: quadrilateral area) is faster than "guessing",

but coding with iteration inters is much easier

here i have a simple concept, just pick at one segment leg then slide.

the rest you can optimize..


(defun c:aaa ( / ang en i k l p p1 ep )
  (and
    (mapcar 'set '(en p) (entsel "Pick segment on LWPOLYLINE.. "))
    (setq p1 (osnap p "nea"))
    (setq p  (trans p1 1 0)
	  i   (fix (vlax-curve-getparamatpoint en p)))
    (setq ep (vlax-curve-getEndParam en))
    (>= ep 3)
    (< 0 i (1- ep))
    (setq ang
	   (mapcar ''((x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x)))
		   (list (1- i) (1+ i))
	   )
    )
    (while
      (and p
	   (mapcar 'set '(k p) (grread t 13))
	   (= 5 k)
	   (setq p1 (trans p 1 0))
      )
       (redraw)
       (setq l
	  (mapcar ''((a b / p)
		     (list
		      (setq p (vlax-curve-getPointAtParam en b))
		      (inters p (polar p a 1.0) p1
		       (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 )
		       nil
		      )
		     )
		    )
		  ang
		(list i (1+ i))
		  
	  )
       )
       (grvecs
	 (apply	'append
		(mapcar
		  ''((x)
		     (cons (car x) (mapcar ''((x) (trans x 0 1)) (cdr x)))
		    )
		  (cons
		    (cons 2 (mapcar 'cadr l))
		    (mapcar ''((x) (cons 2 x))
			    l
		    )
		  )
		)
	 )
       )

    )

  )
  (princ)
)

Thanks for your effort.

I encountered some issues with this lisp.

1. It doesn't work on closed ploylines.

2. It prompts you to select a lwpolyline (unclosed), when i select a poly line i can move right & left and a new yellow boundary line appears but as soon as i click and zoom in or out the yellow line disappears.

3. It doesn't ask anything about area at all. like how much i want it to increase or decrease by.

In the gif you posted above it increases the area by 20 SQM, but when i run this lisp it doesn't asks for that required area input.

Plz reply

Edited March 29, 2020 by xpr0
Add

March 29, 2020

20 hours ago, hanhphuc said:

IMO geometry algorithm (tips: quadrilateral area) is faster than "guessing",

but coding with iteration inters is much easier

here i have a simple concept, just pick at one segment leg then slide.

the rest you can optimize..


(defun c:aaa ( / ang en i k l p p1 ep )
  (and
    (mapcar 'set '(en p) (entsel "Pick segment on LWPOLYLINE.. "))
    (setq p1 (osnap p "nea"))
    (setq p  (trans p1 1 0)
	  i   (fix (vlax-curve-getparamatpoint en p)))
    (setq ep (vlax-curve-getEndParam en))
    (>= ep 3)
    (< 0 i (1- ep))
    (setq ang
	   (mapcar ''((x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x)))
		   (list (1- i) (1+ i))
	   )
    )
    (while
      (and p
	   (mapcar 'set '(k p) (grread t 13))
	   (= 5 k)
	   (setq p1 (trans p 1 0))
      )
       (redraw)
       (setq l
	  (mapcar ''((a b / p)
		     (list
		      (setq p (vlax-curve-getPointAtParam en b))
		      (inters p (polar p a 1.0) p1
		       (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 )
		       nil
		      )
		     )
		    )
		  ang
		(list i (1+ i))
		  
	  )
       )
       (grvecs
	 (apply	'append
		(mapcar
		  ''((x)
		     (cons (car x) (mapcar ''((x) (trans x 0 1)) (cdr x)))
		    )
		  (cons
		    (cons 2 (mapcar 'cadr l))
		    (mapcar ''((x) (cons 2 x))
			    l
		    )
		  )
		)
	 )
       )

    )

  )
  (princ)
)

Very nice @hanhphuc. You cannot select the first or last segment though, perhaps

(defun c:aaa ( / ang en i k l p p1 ep pp np)
  (and  (mapcar 'set '(en p) (entsel "Pick segment on LWPOLYLINE.. "))
        (setq p1 (osnap p "nea"))
        (setq p  (trans p1 1 0))
        (setq i  (fix (vlax-curve-getparamatpoint en p)))
        (setq ep (vlax-curve-getEndParam en))
        (setq np (if (= i (1- ep)) 0 (1+ i)))
        (setq pp (if (zerop i) (1- ep) (1- i)))
        (>= ep 3)
        ;(< 0 i (1- ep))
        (setq ang (mapcar ''((x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x))) (list pp np)))
        (while (and p 
                    (mapcar 'set '(k p) (grread t 13))
                    (= 5 k)
                    (setq p1 (trans p 1 0))
                )
                (redraw)
                (setq l (mapcar ''((a b / p) (list (setq p (vlax-curve-getPointAtParam en b))
                                                   (inters p (polar p a 1.0) p1 (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 ) nil)
                                              )
                                  )
                                  ang
                                  (list i np);(1+ i))
      
                        )
                )
                (grvecs (apply 'append (mapcar ''((x) (cons (car x) (mapcar ''((x) (trans x 0 1)) (cdr x)))) (cons (cons 2 (mapcar 'cadr l)) (mapcar ''((x) (cons 2 x)) l)))))
        )

  )
  (princ)
)

March 29, 2020

Lisp here. There are many cases of line placement, so I have to check and correct the LISP for every situation

in this Lisp, there are messages on the screen, you just read and follow the request at the command line, don't care why it appears and it turns itself off.

If you expand the area, enter the positive area. If you want to “trim” the area, enter the negative area.

In some cases, if you enter a large area, the lisp will not work correctly, unexpectedly, try it and you'll see.

(defun DXF (code en) (cdr (assoc code (entget en))))
;;;=========================================================================
(defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))

;;;=========================================================================
(defun sysvar-set (lst_setvar / strN var var_oldname n)
    (setq n 0
          lstvar_thiep nil
          lstValue_thiep nil
    )
    (repeat (/ (length lst_setvar) 2)
        (setq var         (nth n lst_setvar)
              var_oldname (strcat "oldvar_thiep" (itoa n))
        )
        (setq lstvar_thiep (append lstvar_thiep (list var)))
        (set (read var_oldname) (getvar var))
        (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname))))
        (setvar var (nth (+ n 1) lst_setvar))
        (setq n (+ 2 n))
    )
)

;;;=========================================================================
(defun SYSVAR-RESTORE ()
    (mapcar '(lambda (var value) (setvar var (eval value)))
            lstvar_thiep
            lstValue_thiep
    )
)
;;;=========================================================================
(defun CalcZ (Pt1 Pt2 Pt3 / v w)
    (setq v (mapcar '- Pt1 Pt2)
          w (mapcar '- Pt3 Pt2)
    )
    (- (* (car v) (cadr w)) (* (cadr v) (car w)))
)

;;;-------------------------------------------------------------
;;;=========================================================================
(defun c:dht (/ ent1    ent2    ent3    po1     po2     po3     po4     ang1
                ang2    ang3    dis     m       lstpo1  lstpo2  lstpo3
                lstpo-int1      lstpo-int2      anpha   beta    pS1     pS2
                pS3     pE1     pE2     pE3     h       bit     obj_top poS
                poE     po_in1  po_in2  prom    Area_MAX+       Area_MAX-
               )
    (command "undo" "be")
    (sysvar-set '("cmdecho" 0 "osmode" 0))
    (defun *error* (msg)
        (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
            (princ (strcat "\n** Error: " msg " **"))
        )
        (setq dt nil)
        (acet-ui-status)
        (sysvar-restore)
        (command "undo" "en")
        (princ)
    )
    (acet-ui-status (setq prom "\nPick a LINE bottom edge of the trapezoid ")"LOOK AT")
    (while (OR (NOT (setq ent1
                             (car (entsel prom))
                    )
               )
               (NOT (wcmatch (DXF 0 ent1) "LINE"))
           )
        (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again") "LOOK AT")
        (prompt prom)
    )
    (acet-ui-status (setq prom "\nPick a LINE 1st edge of the trapezoid ")"LOOK AT")
    (while (OR (NOT (setq ent2
                             (car (entsel prom)
                             )
                    )
               )
               (NOT (wcmatch (DXF 0 ent2) "LINE"))
           )
        (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again")"LOOK AT")
        (prompt prom)
    )
    (acet-ui-status (setq prom "\nPick a LINE 2nd edge of the trapezoid ")"LOOK AT")
    (while (OR (NOT (setq ent3
                             (car (entsel prom)
                             )
                    )
               )
               (NOT (wcmatch (DXF 0 ent3) "LINE"))
           )
        (acet-ui-status (setq prom "Pick a LINE is not right, Please pick again")"LOOK AT")
        (prompt prom)
    )

    (setq po1 (vlax-curve-getStartpoint ent1);_bottom edge
          po2 (vlax-curve-getEndpoint ent1))
    (setq pS2 (vlax-curve-getStartpoint ent2);_ 1st side
          pE2 (vlax-curve-getEndpoint ent2))

    (setq pS3 (vlax-curve-getStartpoint ent3);_ 2nd side
          pE3 (vlax-curve-getEndpoint ent3))
    (cond ((Equal po1 ps3 1e-2)
           (setq po4 pE3)
           (cond ((Equal po2 ps2 1e-2) (setq po3 pE2))
                 ((Equal po2 pE2 1e-2) (setq po3 pS2))
           )
          )
          ((Equal po1 pE3 1e-2)
           (setq po4 pS3)
           (cond ((Equal po2 ps2 1e-2) (setq po3 pE2))
                 ((Equal po2 pE2 1e-2) (setq po3 pS2))
           )
          )
          ((Equal po1 ps2 1e-2)
           (setq po4 pE2)
           (cond ((Equal po2 ps3 1e-2) (setq po3 pE3))
                 ((Equal po2 pE3 1e-2) (setq po3 pS3))
           )
          )
          ((Equal po1 pE2 1e-2)
           (setq po4 pS2)
           (cond ((Equal po2 ps3 1e-2) (setq po3 pE3))
                 ((Equal po2 pE3 1e-2) (setq po3 pS3))
           )
          )
    )
    (setvar "cecolor" "1") (point po1)
    (setvar "cecolor" "2") (point po2)
    (setvar "cecolor" "3") (point po3)
    (setvar "cecolor" "4") (point po4)
    (setvar "cecolor" "256")
    (or dt (setq dt (getcfg "AppData/trapezoid/area")) (setq dt 1000))
    (acet-ui-status (setq prom (acet-str-format "\nEnter Area given <%1> : "
                                                (if (numberp dt)
                                                    (rtos dt 2 3)
                                                    dt
                                                )
                                                "LOOK AT"
                               )
                    )
    )



    (setq olddt dt)
    (setq dt (getreal prom))
    


               
    
    (if (null dt)
        (setq dt olddt)
    )
    (if (not (numberp dt))
        (setq dt (atof dt)))
    (acet-ui-status)

    
    
    (if (< dt 0)
        (progn (setq anpha (LM:GetInsideAngle po4 po1 po2))
               (setq beta (LM:GetInsideAngle po1 po2 po3))
        )
        (progn (setq anpha (- pi (LM:GetInsideAngle po4 po1 po2)))
               (setq beta (- pi (LM:GetInsideAngle po1 po2 po3)))
        )
    )
    (Setq bit (CalcZ po1 po4 po2))
   

    (setq dis (distance po1 po2))
    (setq m (+ (/ (cos anpha) (sin anpha)) (/ (cos beta) (sin beta))))
    (cond ((and (> bit 0) (> dt 0)) 
           (setq h (/ (- (sqrt (abs (- (* dis dis) (* 2 m (abs dt))))) dis) m))
          )
          ((and (< bit 0) (< dt 0))
                 (setq h (-(/ (- dis (sqrt (abs (- (* dis dis) (* 2 m (abs dt)))))) m)))
          )
          ((or (and (> bit 0) (< dt 0)) (and (< bit 0) (> dt 0)))
           (setq h  (abs (/ (- dis (sqrt (abs (- (* dis dis) (* 2 m (abs dt)))))) m))
           )
          )
    )
    (Setq obj_top (car (vlax-safearray->list
                           (vlax-variant-value (vla-offset (vlax-ename->vla-object ent1) h))
                       )
                  )
    )
    (setq poS (vlax-curve-getStartpoint obj_top)
          poE (vlax-curve-getEndpoint obj_top))
    (setq po_in1 (inters poS poE po1 po4 nil)
          po_in2 (inters poS poE po2 po3 nil)
    )
    (Line po_in1 po_in2)
    (line po1 po_in1)
    (Line po2 po_in2)
    (vla-delete obj_top)
    (setcfg "AppData/trapezoid/area" (rtos dt 2 3))
    (SYSVAR-RESTORE)
    (command "undo" "en")
    
    (princ "ok")
)
(defun LM:GetInsideAngle ( p1 p2 p3 )
    (   (lambda ( a ) (min a (- (+ pi pi) a)))
        (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
    )
)

March 30, 2020

18 hours ago, xpr0 said:

Thanks for your effort.

I encountered some issues with this lisp.

1. It doesn't work on closed ploylines.

fixed

2. It prompts you to select a lwpolyline (unclosed), when i select a poly line i can move right & left and a new yellow boundary line appears but as soon as i click and zoom in or out the yellow line disappears.

just entmake polyline

3. It doesn't ask anything about area at all. like how much i want it to increase or decrease by.

of course, minimize user input debugging.

The area updates dynamically while moving your cursor, just left click mouse to create additional polyline

In the gif you posted above it increases the area by 20 SQM, but when i run this lisp it doesn't asks for that required area input.

code was just concept demo

as i said, since its structure is provided, it can be optimized to suit your needs.

please appreciate any afford (ideas, concept, psuedo etc..) not just full code.

try learning :

( setq area ( getreal "\nInput area" ) )



(defun c:aaa1 ( /  ang en ep i k l l1 lst n p p1 s )
  
;;(revision 1) hanhphuc  30.03.2020 
  
  (and 
    (setq s (ssget "_:S:E+." '((0 . "LWPOLYLINE"))))
    (setq en (ssname s 0)
          p1 (osnap (cadr (grread t 13)) "_nea"))
    (setq p  (trans p1 1 0)
	  i  (vlax-curve-getparamatpoint en p))
    (setq i   (fix i)
          ep (vlax-curve-getEndParam en))
    (>= ep 2)
    (setq ang (mapcar '(lambda (x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x)))
		   (cond	
		     ( (< i 1)(list (1- ep) (1+ i))  )
		     ( (>= i (1- ep)) (list (1- i) 0))
		     ( (list (1- i) (1+ i)) )
		   )
	   )
    )
    
    (princ "\nStretching segment.. \n")
    
    (while

      (and p
	   (mapcar 'set '(k p) (grread t 13))
	   (= 5 k)
	   (setq p1 (trans p 1 0))
      )
      
       (redraw)

      (if

       (vl-some 'not 
        (setq l (mapcar '(lambda (a b / p )
		     (list
		      (setq p (vlax-curve-getPointAtParam en b))
		      (inters p (polar p a 1.0)
			      p1 (polar p1 (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en i)) 1.0 )
		       nil
		      )
		     )
		    )
		  ang
		 (list i (1+ i)) 
	  	)
	         l1 (apply 'append l)
             n  (length l1) 
	         lst (mapcar '(lambda (x)(nth x l1 )) '(0 1 3 2))
	     )
	    )

       (setq p nil)

      (progn

	(grvecs
	  (apply 'append
		( mapcar
		  '( lambda (x)
		     (cons (car x) (mapcar '(lambda (x) (trans x 0 1)) (cdr x)))
		    )
		  (cons
		    (cons 2 (mapcar 'cadr l))
		    (mapcar '(lambda (x) (cons 2 x))
			    l
		    )
		  )
		)
	  )
     )

    (princ (strcat "\rArea = " (rtos (abs (math:area lst )) 2 2)
		   " M\U+00B2 " )
      )
	
    )
   )
      
  ); while
    
    (entmakex
      (vl-list*	'(0 . "LWPOLYLINE")
		'(100 . "AcDbEntity")
		'(100 . "AcDbPolyline")
		'(70 . 0)
		(cons 90 n )
		(setq lst (mapcar '(lambda (x)(cons 10 x)) lst))
      )
    )

  )
  
  (princ)
  
)


;math formula 			  
;	  | x1  x2  x3  x4  xn.. |
;	1 |   \/  \/  \/  \/     |
;Area=	/ |   /\  /\  /\  /\     |
;	2 | y1  y2  y3  y4  yn.. |
;				  

(defun math:area (l) ;hanhphuc 
  (* (apply '-
	    (mapcar '(lambda (x y)
		       (apply '+
			      (mapcar '* (mapcar x l)
				(mapcar y (append (cdr l) (list (car l)))))
			      ) 
		       ) 
		    '(car cadr)
		    '(cadr car)
		    ) 
	    ) 
     0.5
     )
  
  )

p/s: today start working at home using my engineer's notebook - bricscad v19

not support double quotes lambda ' ' ((x) now changed previous to '(lambda (x)

March 30, 2020

The answer needs to be the whole area not just the new area this can mean reducing as well as increasing though could grip edit to reduce as a start.

Still working on it and a few other things.

March 30, 2020

2 hours ago, BIGAL said:

The answer needs to be the whole area not just the new area this can mean reducing as well as increasing though could grip edit to reduce as a start.

Still working on it and a few other things.

IMO, you can manually trim that 1st picked segment.

or some coding, store the picked point, p1 in extra variable, eg: xp

(setq xp p1 p  (trans p1 1 0) ;...snippet...;

then at the end of the code, add extra command, entmod, addvertices etc..

 (vl-cmdf "_trim" s "" (list en xp) "")

maybe has some glitches?

so i just let it as simple as possible, another problem is bulged polyline..

p/s: math formula: new area, A' = A x S² ,S=scale factor, A= max area (triangle)

try to adopt it

lisp to scale by moving only one side

Recommended Posts

xpr0

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

tranthiep

tranthiep

hanhphuc

Posted Images

BIGAL

Link to comment

Share on other sites

xpr0

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

xpr0

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

xpr0

Link to comment

Share on other sites

xpr0

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

tranthiep

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

xpr0

Link to comment

Share on other sites

dlanorh

Link to comment

Share on other sites

tranthiep

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

hanhphuc

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity