Results 1 to 3 of 3

Thread: Determine point on surface with alternative division of edge curves

  1. #1
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Default Determine point on surface with alternative division of edge curves

    I was recently experimenting with command EDGESURF where variables SURFTAB1 & SURFTAB2 have been specified... Now I am not satisfied with equal and even surface division, so I am interested in obtaining point on surface (say 2nd in M direction, and 2nd in N direction, where (> (and surftab1 surftab2) 2), but now I don't want to start EDGESURF command, neither to set suftab1 and surftab2... I am interested just to calculate point, but with combination of alternative division of edge curves...

    I specified types of alternative division of curves in routine as (more points density near <S>tart point, near <E>nd point, near <B>oth start & end points, near <M>iddle point, of finaly <C>lassic division with equal and even array of points)... Routine :

    Code:
    (defun c:divalternate ( / DPT ENT ENTA IZB K L N NN NP NR OSCMD PT PTL X Z)
    (command "ucs" "w")
    (setq oscmd (getvar 'osmode))
    (setvar 'osmode 0)
    (setq ent (car (entsel "\nPick 2D or 3D curve entity for division with more points density")))
    (setq n (getint "\nInput number for division : "))
    (setq nr (atof (itoa n)))
    (initget 7 "Start End Both Middle Classic")
    (setq izb (getkword "\nInput where is more points density (Start, End, Start&End - 
    
    Both, Middle) or Classic even and equal division <S,E,B,M,C> : "))
    (vl-load-com)
    (setq entA (vlax-ename->vla-object ent))
    (setq l (vlax-curve-getDistAtPoint entA (vlax-curve-getEndPoint entA)))
    (if (eq izb "Start")
    (progn
    (setq k -1)
    (setq x (/ l (/ (* nr (+ nr 1)) 2)))
    (repeat (fix (+ nr 1))
    (setq k (+ k 1))
    (setq dpt (* (/ (* k (+ k 1)) 2) x))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    ))
    (if (eq izb "End")
    (progn
    (setq k (fix (+ nr 1)))
    (setq x (/ l (/ (* nr (+ nr 1)) 2)))
    (repeat (fix (+ nr 1))
    (setq k (- k 1))
    (setq dpt (- l (* (/ (* k (+ k 1)) 2) x)))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    ))
    (if (eq izb "Both")
    (progn
    (setq np (/ nr 2))
    (if (= np (atof (itoa (fix np))) )
    (progn
    (setq k -1)
    (setq x (/ l (/ (* np (+ np 1)) 1)))
    (repeat (fix np)
    (setq k (+ k 1))
    (setq dpt (* (/ (* k (+ k 1)) 2) x)) 
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    (setq k (fix (+ np 1)))
    (setq x (/ l (/ (* np (+ np 1)) 1)))
    (repeat (fix (+ np 1))
    (setq k (- k 1))
    (setq dpt (- l (* (/ (* k (+ k 1)) 2) x)))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    )
    (progn
    (setq nn (+ nr 1))
    (setq np (/ nn 2))
    (setq k -1)
    (setq x (/ l (expt (/ (+ nr 1) 2) 2)))
    (repeat (fix np)
    (setq k (+ k 1))
    (setq dpt (* (/ (* k (+ k 1)) 2) x)) 
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    (setq k (fix np))
    (setq x (/ l (expt (/ (+ nr 1) 2) 2)))
    (repeat (fix np)
    (setq k (- k 1))
    (setq dpt (- l (* (/ (* k (+ k 1)) 2) x)))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    ))
    ))
    (if (eq izb "Middle")
    (progn
    (setq np (/ nr 2))
    (if (= np (atof (itoa (fix np))) )
    (progn
    (setq k (fix (+ np 1)))
    (setq x (/ l (/ (* np (+ np 1)) 1)))
    (repeat (fix (+ np 1))
    (setq k (- k 1))
    (setq dpt (- (/ l 2) (* (/ (* k (+ k 1)) 2) x))) 
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    (setq k 0)
    (setq x (/ l (/ (* np (+ np 1)) 1)))
    (repeat (fix np)
    (setq k (+ k 1))
    (setq dpt (+ (/ l 2) (* (/ (* k (+ k 1)) 2) x)))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    )
    (progn
    (setq nn (+ nr 1))
    (setq np (/ nn 2))
    (setq z 0)
    (setq k -1)
    (setq x (/ l (/ (+ (expt nr 2) (* nr 4) (- 1)) 4)))
    (repeat (fix np)
    (setq k (+ k 1))
    (setq z (+ z k 1))
    (if (= k 0) (setq z 0))
    (setq dpt (- (/ l 2) (+ (/ x 2) (* z x))))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (setq ptl (cons pt ptl))
    )
    (setq ptl (reverse ptl))
    (foreach pt ptl (command "point" pt))
    (setq k -1)
    (setq z 0)
    (setq x (/ l (/ (+ (expt nr 2) (* nr 4) (- 1)) 4)))
    (repeat (fix np)
    (setq k (+ k 1))
    (setq z (+ z k 1))
    (if (= k 0) (setq z 0))
    (setq dpt (+ (/ l 2) (+ (/ x 2) (* z x))))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    ))
    ))
    (if (eq izb "Classic")
    (progn
    (setq k -1)
    (setq x (/ l nr))
    (repeat (fix (+ nr 1))
    (setq k (+ k 1))
    (setq dpt (* k x))
    (setq pt (vlax-curve-getPointAtDist entA dpt))
    (command "point" pt)
    )
    ))
    (setvar 'pdmode 3)
    (setvar 'pdsize 0)
    (setvar 'osmode oscmd)
    (princ)
    )
    If someone knows how EDGESURF, or LOFT with 2 crosssections curve entity edges and 2 guide curve entity edges, functions, any help would be appreciated... Maybe for this I need to obtain formula for surface and I don't know how... Or it would be even better if someone could construct this surface net with 3DFACE objects, but with points on edges with combination of this alternative division...

    BTW, I don't know how to apply this alternative division for 3D curves as (vlax-curve-getPointAtDist entA dpt) function functions only for 2D splines, or 2D plines, or 2D 3Dpolylines...
    I actually don't know, now I test it with 3D 3Dpoly, 3D spline, 3D helix and it worked (maybe earlier something was different with my CAD)

    M.R.
    Last edited by marko_ribar; 2011-01-29 at 02:16 PM. Reason: another test gave me different result when dividing 3dpoly...

  2. #2
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Smile Re: Determine point on surface with alternative division of edge curves

    Here are 2 my newest codes (I did it all by myself) :

    Code:
    (defun faces2face (Mk0 Nk0 Mkk Nkk / dkk)
    (setq DMkk (+ (- Mkk Mk0) 1))
    (setq DNkk (+ (- Nkk Nk0) 1))
    (setq ss (ssadd))
    (setq kk -1)
    (setq ff -1)
    (setq dm 0.0)
    (repeat DMkk
    (setq ff (+ ff 1))
    (if (= ff 0) (progn (setq kk -1) (setq kk (+ Mk0 (+ kk 1))) )
    (setq kk (+ kk 1))
    )
    (setq dm (* kk Nkr))
    (setq ll -1)
    (repeat DNkk
    (setq ll (+ ll 1))
    (setq dkk (+ Nk0 dm ll))
    (setq ent (ssname faces (fix dkk)))
    (ssadd ent ss)
    )
    )
    (setq gg -1)
    (repeat (sslength ss)  
    (setq gg (+ gg 1))
    (setq ent (ssname ss gg))
    (setq pt1 (cdr (assoc 10 (entget ent))))
    (setq pt2 (cdr (assoc 11 (entget ent))))
    (setq pt3 (cdr (assoc 12 (entget ent))))
    (setq pt4 (cdr (assoc 13 (entget ent))))
    (if (= (atof (itoa gg)) 0.0) (setq ptl (cons pt1 ptl)) )
    (if (= (atof (itoa gg)) (- (atof (itoa DNkk)) 1)) (setq ptl (cons pt4 ptl)) )
    (if (= (atof (itoa gg)) (- (- (sslength ss) 1) (- (atof (itoa DNkk)) 1))) (setq ptl (cons pt2 ptl)) )
    (if (= (atof (itoa gg)) (- (sslength ss) 1)) (setq ptl (cons pt3 ptl)) ) 
    )
    
    (if (/= (cadddr ptl) nil)
    (progn
    (setq pt1 (nth 3 ptl))
    (setq pt2 (nth 1 ptl))
    (setq pt3 (nth 0 ptl))
    (setq pt4 (nth 2 ptl))
    (command "3DFACE" pt1 pt2 pt3 pt4 "")
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt3 nil)
    (setq pt4 nil)
    ))
    )
    
    (defun c:edgesurfcent-lowdensity ( / Mk0 Mkk Nk0 Nkk)
    (setq Mk0 nil Mkk nil Nk0 nil Nkk nil)
    (setq M (getint "\nInput segments in M direction <must be odd number> : "))
    (setq N (getint "\nInput segments in N direction <must be odd number> : "))
    (setq Mr (atof (itoa M)))
    (setq Nr (atof (itoa N)))
    (setq Mk (expt (/ (+ Mr 1) 2) 2))
    (setq Mkr (atof (itoa (fix Mk))))
    (setq Nk (expt (/ (+ Nr 1) 2) 2))
    (setq Nkr (atof (itoa (fix Nk))))
    (setvar 'surftab1 Mk)
    (setvar 'surftab2 Nk)
    (setq e1 (car (entsel "\nPick first 2d or 3d curve for edgesurf")))
    (setq e2 (car (entsel "\nPick second 2d or 3d curve for edgesurf")))
    (setq e3 (car (entsel "\nPick third 2d or 3d curve for edgesurf")))
    (setq e4 (car (entsel "\nPick fourth 2d or 3d curve for edgesurf")))
    (command "edgesurf" e1 e2 e3 e4)
    (setq surf (entlast))
    (command "explode" surf "")
    (setq faces (ssget "P"))
    (setq Mpar (/ Mr 2))
    (setq mmm 0)
    (setq qm -1)
    (setq qqm 0)
    (setq ym 0.0)
    (repeat M
    (setq ym (+ ym 1.0))
    (if (> ym (+ Mpar 2)) (setq qqm 2))
    (setq qm (- (+ qm 1) qqm))
    (setq mmm (+ mmm qm))
    (if (> ym (+ Mpar 1))  
    (setq mmmm (+ mmm qm (- 2)))
    (setq mmmm (+ mmm qm))
    )
    (setq Mk0 mmm)
    (setq Mkk mmmm)
    (if (and (/= mmm 0) (equal mmm mmmm)) (setq mmm 0 ym 0.0 qqm 0 qm -1))
    (setq Npar (/ Nr 2))
    (setq nnn 0)
    (setq qn -1)
    (setq qqn 0)
    (setq zn 0.0)
    (repeat N
    (setq zn (+ zn 1.0))
    (if (> zn (+ Npar 2)) (setq qqn 2))
    (setq qn (- (+ qn 1) qqn))
    (setq nnn (+ nnn qn))
    (if (> zn (+ Npar 1))  
    (setq nnnn (+ nnn qn (- 2)))
    (setq nnnn (+ nnn qn))
    )
    (setq Nk0 nnn)
    (setq Nkk nnnn)
    (if (and (/= nnn 0) (equal nnn nnnn)) (setq nnn 0 zn 0.0 qqn 0 qn -1))
    (faces2face Mk0 Nk0 Mkk Nkk)
    )
    )
    (command "erase" faces "")
    (princ)
    )
    And another one :

    Code:
    (defun faces2face (Mk0 Nk0 Mkk Nkk / dkk)
    (setq DMkk (+ (- Mkk Mk0) 1))
    (setq DNkk (+ (- Nkk Nk0) 1))
    (setq ss (ssadd))
    (setq kk -1)
    (setq ff -1)
    (setq dm 0.0)
    (repeat DMkk
    (setq ff (+ ff 1))
    (if (= ff 0) (progn (setq kk -1) (setq kk (+ Mk0 (+ kk 1))) )
    (setq kk (+ kk 1))
    )
    (setq dm (* kk Nkr))
    (setq ll -1)
    (repeat DNkk
    (setq ll (+ ll 1))
    (setq dkk (+ Nk0 dm ll))
    (setq ent (ssname faces (fix dkk)))
    (ssadd ent ss)
    )
    )
    (setq gg -1)
    (repeat (sslength ss)  
    (setq gg (+ gg 1))
    (setq ent (ssname ss gg))
    (setq pt1 (cdr (assoc 10 (entget ent))))
    (setq pt2 (cdr (assoc 11 (entget ent))))
    (setq pt3 (cdr (assoc 12 (entget ent))))
    (setq pt4 (cdr (assoc 13 (entget ent))))
    (if (= (atof (itoa gg)) 0.0) (setq ptl (cons pt1 ptl)) )
    (if (= (atof (itoa gg)) (- (atof (itoa DNkk)) 1)) (setq ptl (cons pt4 ptl)) )
    (if (= (atof (itoa gg)) (- (- (sslength ss) 1) (- (atof (itoa DNkk)) 1))) (setq ptl (cons pt2 ptl)) )
    (if (= (atof (itoa gg)) (- (sslength ss) 1)) (setq ptl (cons pt3 ptl)) ) 
    )
    
    (if (/= (cadddr ptl) nil)
    (progn
    (setq pt1 (nth 3 ptl))
    (setq pt2 (nth 1 ptl))
    (setq pt3 (nth 0 ptl))
    (setq pt4 (nth 2 ptl))
    (command "3DFACE" pt1 pt2 pt3 pt4 "")
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt3 nil)
    (setq pt4 nil)
    ))
    )
    
    (defun c:edgesurfcent-highdensity ( / Mk0 Mkk Nk0 Nkk)
    (setq Mk0 nil Mkk nil Nk0 nil Nkk nil)
    (setq M (getint "\nInput segments in M direction <must be odd number> : "))
    (setq N (getint "\nInput segments in N direction <must be odd number> : "))
    (setq Mr (atof (itoa M)))
    (setq Nr (atof (itoa N)))
    (setq Mk (/ (+ (expt Mr 2) (* 4 Mr) (- 1)) 4))
    (setq Mkr (atof (itoa (fix Mk))))
    (setq Nk (/ (+ (expt Nr 2) (* 4 Nr) (- 1)) 4))
    (setq Nkr (atof (itoa (fix Nk))))
    (setvar 'surftab1 Mk)
    (setvar 'surftab2 Nk)
    (setq e1 (car (entsel "\nPick first 2d or 3d curve for edgesurf")))
    (setq e2 (car (entsel "\nPick second 2d or 3d curve for edgesurf")))
    (setq e3 (car (entsel "\nPick third 2d or 3d curve for edgesurf")))
    (setq e4 (car (entsel "\nPick fourth 2d or 3d curve for edgesurf")))
    (command "edgesurf" e1 e2 e3 e4)
    (setq surf (entlast))
    (command "explode" surf "")
    (setq faces (ssget "P"))
    (setq Mxr (atof (itoa (fix (sqrt Mkr)))))
    (setq Nxr (atof (itoa (fix (sqrt Nkr)))))
    (setq Mpar (/ Mr 2))
    (setq mmm 0)
    (setq qm (fix Mxr))
    (setq qqm 0)
    (setq ym 0.0)
    (repeat M
    (setq ym (+ ym 1.0))
    (if (= ym 1.0) (setq mmm 0)
    (progn
    (if (> ym (+ Mpar 1)) (setq qqm 2))
    (setq qm (+ (- qm 1) qqm))
    (if (> ym (+ Mpar 1)) (setq mmm (+ mmm qm (- 1))) (setq mmm (+ mmm qm 1)))
    ))
    (setq mmmm (+ mmm qm (- 1)))
    (setq Mk0 (fix mmm))
    (setq Mkk (fix mmmm))
    (setq Npar (/ Nr 2))
    (setq nnn 0)
    (setq qn (fix Nxr))
    (setq qqn 0)
    (setq zn 0.0)
    (repeat N
    (setq zn (+ zn 1.0))
    (if (= zn 1.0) (setq nnn 0)
    (progn
    (if (> zn (+ Npar 1)) (setq qqn 2))
    (setq qn (+ (- qn 1) qqn))
    (if (> zn (+ Npar 1)) (setq nnn (+ nnn qn (- 1))) (setq nnn (+ nnn qn 1)))
    ))
    (setq nnnn (+ nnn qn (- 1)))
    (setq Nk0 (fix nnn))
    (setq Nkk (fix nnnn))
    (faces2face Mk0 Nk0 Mkk Nkk)
    )
    )
    (command "erase" faces "")
    (princ)
    )
    BTW, don't input too big odd number, it needs lots of time even if ACAD is optimized for lisp performance...

    M.R.

  3. #3
    All AUGI, all the time
    Join Date
    2015-10
    Location
    Belgrade, Serbia, Europe
    Posts
    564
    Login to Give a bone
    0

    Smile Re: Determine point on surface with alternative division of edge curves

    For even numbers - these 2 lisps :

    Code:
    (defun faces2face (Mk0 Nk0 Mkk Nkk / dkk)
    (setq DMkk (+ (- Mkk Mk0) 1))
    (setq DNkk (+ (- Nkk Nk0) 1))
    (setq ss (ssadd))
    (setq kk -1)
    (setq ff -1)
    (setq dm 0.0)
    (repeat DMkk
    (setq ff (+ ff 1))
    (if (= ff 0) (progn (setq kk -1) (setq kk (+ Mk0 (+ kk 1))) )
    (setq kk (+ kk 1))
    )
    (setq dm (* kk Nkr))
    (setq ll -1)
    (repeat DNkk
    (setq ll (+ ll 1))
    (setq dkk (+ Nk0 dm ll))
    (setq ent (ssname faces (fix dkk)))
    (ssadd ent ss)
    )
    )
    (setq gg -1)
    (repeat (sslength ss)  
    (setq gg (+ gg 1))
    (setq ent (ssname ss gg))
    (setq pt1 (cdr (assoc 10 (entget ent))))
    (setq pt2 (cdr (assoc 11 (entget ent))))
    (setq pt3 (cdr (assoc 12 (entget ent))))
    (setq pt4 (cdr (assoc 13 (entget ent))))
    (if (= (atof (itoa gg)) 0.0) (setq ptl (cons pt1 ptl)) )
    (if (= (atof (itoa gg)) (- (atof (itoa DNkk)) 1)) (setq ptl (cons pt4 ptl)) )
    (if (= (atof (itoa gg)) (- (- (sslength ss) 1) (- (atof (itoa DNkk)) 1))) (setq ptl (cons pt2 ptl)) )
    (if (= (atof (itoa gg)) (- (sslength ss) 1)) (setq ptl (cons pt3 ptl)) ) 
    )
    
    (if (/= (cadddr ptl) nil)
    (progn
    (setq pt1 (nth 3 ptl))
    (setq pt2 (nth 1 ptl))
    (setq pt3 (nth 0 ptl))
    (setq pt4 (nth 2 ptl))
    (command "3DFACE" pt1 pt2 pt3 pt4 "")
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt3 nil)
    (setq pt4 nil)
    ))
    )
    
    (defun c:edgesurfcent-highdensity ( / Mk0 Mkk Nk0 Nkk)
    (setq Mk0 nil Mkk nil Nk0 nil Nkk nil)
    (setq M (getint "\nInput segments in M direction <must be even number> : "))
    (setq N (getint "\nInput segments in N direction <must be even number> : "))
    (setq Mr (atof (itoa M)))
    (setq Nr (atof (itoa N)))
    (setq Mk (/ (* Mr (+ Mr 2)) 4))
    (setq Mkr (atof (itoa (fix Mk))))
    (setq Nk (/ (* Nr (+ Nr 2)) 4))
    (setq Nkr (atof (itoa (fix Nk))))
    (setvar 'surftab1 Mk)
    (setvar 'surftab2 Nk)
    (setq e1 (car (entsel "\nPick first 2d or 3d curve for edgesurf")))
    (setq e2 (car (entsel "\nPick second 2d or 3d curve for edgesurf")))
    (setq e3 (car (entsel "\nPick third 2d or 3d curve for edgesurf")))
    (setq e4 (car (entsel "\nPick fourth 2d or 3d curve for edgesurf")))
    (command "edgesurf" e1 e2 e3 e4)
    (setq surf (entlast))
    (command "explode" surf "")
    (setq faces (ssget "P"))
    ;(setq Mxr (atof (itoa (fix (sqrt Mr)))))
    ;(setq Nxr (atof (itoa (fix (sqrt Nr)))))
    (setq Mpar (/ Mr 2))
    (setq mmm 0)
    (setq qm (fix Mpar))
    (setq qqm 0)
    (setq ym -1.0)
    (repeat M
    (setq ym (+ ym 1.0))
    (if (= ym 0.0) (setq mmm 0 mmmm (+ mmm qm (- 1))))
    (if (and (/= ym 0.0) (< ym Mpar))
    (progn
    (setq qm (- qm 1))
    (setq mmm (+ mmm qm 1))
    (setq mmmm (+ mmm qm (- 1)))
    ))
    (if (= ym Mpar)
    (progn
    (setq mmm (+ mmm qm))
    (setq mmmm (+ mmm qm (- 1)))
    ))
    (if (> ym Mpar) 
    (progn
    (setq qqm 2)
    (setq qm (+ (- qm 1) qqm))
    (setq mmm (+ mmm qm (- 1)))
    (setq mmmm (+ mmm qm (- 1)))
    ))
    (setq Mk0 (fix mmm))
    (setq Mkk (fix mmmm))
    (setq Npar (/ Nr 2))
    (setq nnn 0)
    (setq qn (fix Npar))
    (setq qqn 0)
    (setq zn -1.0)
    (repeat N
    (setq zn (+ zn 1.0))
    (if (= zn 0.0) (setq nnn 0 nnnn (+ nnn qn (- 1))))
    (if (and (/= zn 0.0) (< zn Mpar))
    (progn
    (setq qn (- qn 1))
    (setq nnn (+ nnn qn 1))
    (setq nnnn (+ nnn qn (- 1)))
    ))
    (if (= zn Mpar)
    (progn
    (setq nnn (+ nnn qn))
    (setq nnnn (+ nnn qn (- 1)))
    ))
    (if (> zn Mpar) 
    (progn
    (setq qqn 2)
    (setq qn (+ (- qn 1) qqn))
    (setq nnn (+ nnn qn (- 1)))
    (setq nnnn (+ nnn qn (- 1)))
    ))
    (setq Nk0 (fix nnn))
    (setq Nkk (fix nnnn))
    (faces2face Mk0 Nk0 Mkk Nkk)
    )
    )
    (command "erase" faces "")
    (princ)
    )
    and this one :

    Code:
    (defun faces2face (Mk0 Nk0 Mkk Nkk / dkk)
    (setq DMkk (+ (- Mkk Mk0) 1))
    (setq DNkk (+ (- Nkk Nk0) 1))
    (setq ss (ssadd))
    (setq kk -1)
    (setq ff -1)
    (setq dm 0.0)
    (repeat DMkk
    (setq ff (+ ff 1))
    (if (= ff 0) (progn (setq kk -1) (setq kk (+ Mk0 (+ kk 1))) )
    (setq kk (+ kk 1))
    )
    (setq dm (* kk Nkr))
    (setq ll -1)
    (repeat DNkk
    (setq ll (+ ll 1))
    (setq dkk (+ Nk0 dm ll))
    (setq ent (ssname faces (fix dkk)))
    (ssadd ent ss)
    )
    )
    (setq gg -1)
    (repeat (sslength ss)  
    (setq gg (+ gg 1))
    (setq ent (ssname ss gg))
    (setq pt1 (cdr (assoc 10 (entget ent))))
    (setq pt2 (cdr (assoc 11 (entget ent))))
    (setq pt3 (cdr (assoc 12 (entget ent))))
    (setq pt4 (cdr (assoc 13 (entget ent))))
    (if (= (atof (itoa gg)) 0.0) (setq ptl (cons pt1 ptl)) )
    (if (= (atof (itoa gg)) (- (atof (itoa DNkk)) 1)) (setq ptl (cons pt4 ptl)) )
    (if (= (atof (itoa gg)) (- (- (sslength ss) 1) (- (atof (itoa DNkk)) 1))) (setq ptl (cons pt2 ptl)) )
    (if (= (atof (itoa gg)) (- (sslength ss) 1)) (setq ptl (cons pt3 ptl)) ) 
    )
    
    (if (/= (cadddr ptl) nil)
    (progn
    (setq pt1 (nth 3 ptl))
    (setq pt2 (nth 1 ptl))
    (setq pt3 (nth 0 ptl))
    (setq pt4 (nth 2 ptl))
    (command "3DFACE" pt1 pt2 pt3 pt4 "")
    (setq pt1 nil)
    (setq pt2 nil)
    (setq pt3 nil)
    (setq pt4 nil)
    ))
    )
    
    (defun c:edgesurfcent-lowdensity ( / Mk0 Mkk Nk0 Nkk)
    (setq Mk0 nil Mkk nil Nk0 nil Nkk nil)
    (setq M (getint "\nInput segments in M direction <must be even number> : "))
    (setq N (getint "\nInput segments in N direction <must be even number> : "))
    (setq Mr (atof (itoa M)))
    (setq Nr (atof (itoa N)))
    (setq Mk (/ (* Mr (+ Mr 2)) 4))
    (setq Mkr (atof (itoa (fix Mk))))
    (setq Nk (/ (* Nr (+ Nr 2)) 4))
    (setq Nkr (atof (itoa (fix Nk))))
    (setvar 'surftab1 Mk)
    (setvar 'surftab2 Nk)
    (setq e1 (car (entsel "\nPick first 2d or 3d curve for edgesurf")))
    (setq e2 (car (entsel "\nPick second 2d or 3d curve for edgesurf")))
    (setq e3 (car (entsel "\nPick third 2d or 3d curve for edgesurf")))
    (setq e4 (car (entsel "\nPick fourth 2d or 3d curve for edgesurf")))
    (command "edgesurf" e1 e2 e3 e4)
    (setq surf (entlast))
    (command "explode" surf "")
    (setq faces (ssget "P"))
    ;(setq Mxr (atof (itoa (fix (sqrt Mr)))))
    ;(setq Nxr (atof (itoa (fix (sqrt Nr)))))
    (setq Mpar (/ Mr 2))
    (setq mmm 0)
    (setq qm 0)
    (setq qqm 0)
    (setq ym -1.0)
    (repeat M
    (setq ym (+ ym 1.0))
    (if (= ym 0.0) (setq mmm 0 mmmm (+ mmm qm)))
    (if (and (/= ym 0.0) (< ym Mpar))
    (progn
    (setq qm (+ qm 1))
    (setq mmm (+ mmm qm))
    (setq mmmm (+ mmm qm))
    ))
    (if (= ym Mpar)
    (progn
    (setq mmm (+ mmm qm 1))
    (setq mmmm (+ mmm qm))
    ))
    (if (> ym Mpar) 
    (progn
    (setq qqm 2)
    (setq qm (- (+ qm 1) qqm))
    (setq mmm (+ mmm qm 2))
    (setq mmmm (+ mmm qm))
    ))
    (setq Mk0 (fix mmm))
    (setq Mkk (fix mmmm))
    (setq Npar (/ Nr 2))
    (setq nnn 0)
    (setq qn 0)
    (setq qqn 0)
    (setq zn -1.0)
    (repeat N
    (setq zn (+ zn 1.0))
    (if (= zn 0.0) (setq nnn 0 nnnn (+ nnn qn)))
    (if (and (/= zn 0.0) (< zn Mpar))
    (progn
    (setq qn (+ qn 1))
    (setq nnn (+ nnn qn))
    (setq nnnn (+ nnn qn))
    ))
    (if (= zn Mpar)
    (progn
    (setq nnn (+ nnn qn 1))
    (setq nnnn (+ nnn qn))
    ))
    (if (> zn Mpar) 
    (progn
    (setq qqn 2)
    (setq qn (- (+ qn 1) qqn))
    (setq nnn (+ nnn qn 2))
    (setq nnnn (+ nnn qn))
    ))
    (setq Nk0 (fix nnn))
    (setq Nkk (fix nnnn))
    (faces2face Mk0 Nk0 Mkk Nkk)
    )
    )
    (command "erase" faces "")
    (princ)
    )
    Also don't input large even numbers...

    M.R.

Similar Threads

  1. Create an irregular surface from selected point in a point cloud
    By Wish List System in forum Civil 3D Wish List
    Replies: 0
    Last Post: 2012-03-10, 12:15 PM
  2. Revit - edge smoothing for curves
    By tuneslover in forum Revit Architecture - Families
    Replies: 1
    Last Post: 2010-11-26, 12:10 PM
  3. Autolisp function to determine point location
    By BrenBren in forum API Wish List
    Replies: 2
    Last Post: 2010-09-28, 03:45 PM
  4. Place a plane on a tangent edge of a circle with a parallel surface or edge.
    By inventor.wishlist1738 in forum Inventor Wish List
    Replies: 0
    Last Post: 2010-09-22, 12:51 PM
  5. Autolisp Function to Determine Point Location
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 2
    Last Post: 2008-05-21, 10:50 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •