Density M or N

[carlos_m_gil_p]

Hello how are you.

Can someone help me with a lisp.
Deputy DWG so I can understand.

Excuse my English only speak Spanish.
Thank you.

[stevor]

If you do not get a suitable answer,

save the DWG to 2000 or so version;

and state what you want done to it.

And use   https://translate.google.com,

if in doubt of the words.

[carlos_m_gil_p]

Hello how are you,
Thank you for your collaboration.

Deputy DWG version 2000.

Thank you.

[marko_ribar]

Carlos, search for plugin MPanel for AutoCAD and look into tutorials to understand how to work in that particular environment... That DWG you attached was recently posted on www.theswamp.org under show stuff forum, so you need to be member to access it... Here is link if you're interested to look and discuss :

https://www.theswamp.org/index.php?topic=51823.0

Regards, M.R.

[carlos_m_gil_p]

Hi.
I do not have that program.
I would like a lisp that could change the amount of M and N

Thank you.

[marko_ribar]

Beside my routine EDGENET which have built-in options 2x2;4x4;8x8;16x16;32x32;64x64 mesh densities, without that plug-in - MPanel, you could only use built-in commands like : EDGESURF, REVSURF, RULESURF and TABSURF and they all can be used in relation of specified densities in M direction : SURFTAB1 sysvar and N direction : SURFTAB2 sysvar...

HTH, M.R.

[carlos_m_gil_p]

I do not know much about programming.

[marko_ribar]

Carlos, I've made new input on the link I provided at theswamp... If you are unable to access it, I'll post here my latest version of edgenet routine...

(defun c:edgenet-new ( / *error* gridcoeff *adoc* e1 e2 e3 e4 m n de1 de2 de3 de4 lst mm nn p1 p2 p3 p4 ll lr ur ul kll klr kur kul il plst pplst pmsh ex )

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark *adoc*)
    (if m
      (prompt m)
    )
    (redraw e1 4)
    (redraw e2 4)
    (redraw e3 4)
    (redraw e4 4)
    (princ)
  )

  (defun gridcoeff ( m n il ex / mp mm nn p ll lr ul ur lst )
    (setq mp (list (/ m 2) (/ n 2)) mm 0)
    (repeat m
      (setq mm (1+ mm) nn 0)
      (repeat n
        (setq nn (1+ nn))
        (setq p (list mm nn))
        (setq ll (list (+ (* (if (<= (1- nn) (cadr mp)) 1.0 -1.0) (expt (/ (float (abs (- (cadr mp) (1- nn)))) (float (cadr mp))) 2) (- (car (nth 1 il)) (cadr (nth 4 il)))) (cadr (nth 4 il)))
                     (+ (* (if (<= (1- mm) (car mp)) -1.0 1.0) (expt (/ (float (abs (- (car mp) (1- mm)))) (float (car mp))) 2) (- (cadr (nth 5 il)) (caddr (nth 4 il)))) (caddr (nth 4 il)))
                     (+ (* (if (<= (1- nn) (cadr mp)) -1.0 1.0) (expt (/ (float (abs (- (cadr mp) (1- nn)))) (float (cadr mp))) 2) (- (caddr (nth 7 il)) (cadddr (nth 4 il)))) (cadddr (nth 4 il)))
                     (+ (* (if (<= (1- mm) (car mp)) 1.0 -1.0) (expt (/ (float (abs (- (car mp) (1- mm)))) (float (car mp))) 2) (- (cadddr (nth 3 il)) (car (nth 4 il)))) (car (nth 4 il)))
                )
        )
        (setq lr (list (+ (* (if (<= (1- nn) (cadr mp)) 1.0 -1.0) (expt (/ (float (abs (- (cadr mp) (1- nn)))) (float (cadr mp))) 2) (- (car (nth 1 il)) (cadr (nth 4 il)))) (cadr (nth 4 il)))
                     (+ (* (if (<= mm (car mp)) -1.0 1.0) (expt (/ (float (abs (- (car mp) mm))) (float (car mp))) 2) (- (cadr (nth 5 il)) (caddr (nth 4 il)))) (caddr (nth 4 il)))
                     (+ (* (if (<= (1- nn) (cadr mp)) -1.0 1.0) (expt (/ (float (abs (- (cadr mp) (1- nn)))) (float (cadr mp))) 2) (- (caddr (nth 7 il)) (cadddr (nth 4 il)))) (cadddr (nth 4 il)))
                     (+ (* (if (<= mm (car mp)) 1.0 -1.0) (expt (/ (float (abs (- (car mp) mm))) (float (car mp))) 2) (- (cadddr (nth 3 il)) (car (nth 4 il)))) (car (nth 4 il)))
                )
        )
        (setq ul (list (+ (* (if (<= nn (cadr mp)) 1.0 -1.0) (expt (/ (float (abs (- (cadr mp) nn))) (float (cadr mp))) 2) (- (car (nth 1 il)) (cadr (nth 4 il)))) (cadr (nth 4 il)))
                     (+ (* (if (<= (1- mm) (car mp)) -1.0 1.0) (expt (/ (float (abs (- (car mp) (1- mm)))) (float (car mp))) 2) (- (cadr (nth 5 il)) (caddr (nth 4 il)))) (caddr (nth 4 il)))
                     (+ (* (if (<= nn (cadr mp)) -1.0 1.0) (expt (/ (float (abs (- (cadr mp) nn))) (float (cadr mp))) 2) (- (caddr (nth 7 il)) (cadddr (nth 4 il)))) (cadddr (nth 4 il)))
                     (+ (* (if (<= (1- mm) (car mp)) 1.0 -1.0) (expt (/ (float (abs (- (car mp) (1- mm)))) (float (car mp))) 2) (- (cadddr (nth 3 il)) (car (nth 4 il)))) (car (nth 4 il)))
                )
        )
        (setq ur (list (+ (* (if (<= nn (cadr mp)) 1.0 -1.0) (expt (/ (float (abs (- (cadr mp) nn))) (float (cadr mp))) 2) (- (car (nth 1 il)) (cadr (nth 4 il)))) (cadr (nth 4 il)))
                     (+ (* (if (<= mm (car mp)) -1.0 1.0) (expt (/ (float (abs (- (car mp) mm))) (float (car mp))) 2) (- (cadr (nth 5 il)) (caddr (nth 4 il)))) (caddr (nth 4 il)))
                     (+ (* (if (<= nn (cadr mp)) -1.0 1.0) (expt (/ (float (abs (- (cadr mp) nn))) (float (cadr mp))) 2) (- (caddr (nth 7 il)) (cadddr (nth 4 il)))) (cadddr (nth 4 il)))
                     (+ (* (if (<= mm (car mp)) 1.0 -1.0) (expt (/ (float (abs (- (car mp) mm))) (float (car mp))) 2) (- (cadddr (nth 3 il)) (car (nth 4 il)))) (car (nth 4 il)))
                )
        )
        (setq lst (cons (list p ll lr ul ur) lst))
      )
    )
    (setq lst (mapcar '(lambda ( x ) (cons (car x) (mapcar '(lambda ( y ) (mapcar '(lambda ( z ) (expt z ex)) y)) (cdr x)))) lst))
    (setq mm 0)
    (repeat m
      (setq mm (1+ mm) nn 0)
      (repeat n
        (setq nn (1+ nn))
        (setq p (list mm nn))
        (if (= mm 1)
          (setq lst (subst (list p (list 0.0 0.0 0.0 1.0) (nth 2 (assoc p lst)) (list 0.0 0.0 0.0 1.0) (nth 4 (assoc p lst))) (assoc p lst) lst))
        )
        (if (= nn 1)
          (setq lst (subst (list p (list 1.0 0.0 0.0 0.0) (list 1.0 0.0 0.0 0.0) (nth 3 (assoc p lst)) (nth 4 (assoc p lst))) (assoc p lst) lst))
        )
        (if (= mm m)
          (setq lst (subst (list p (nth 1 (assoc p lst)) (list 0.0 1.0 0.0 0.0) (nth 3 (assoc p lst)) (list 0.0 1.0 0.0 0.0)) (assoc p lst) lst))
        )
        (if (= nn n)
          (setq lst (subst (list p (nth 1 (assoc p lst)) (nth 2 (assoc p lst)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 1.0 0.0)) (assoc p lst) lst))
        )
        (if (and (= mm 1) (= nn 1))
          (setq lst (subst (list p (list 1.0 0.0 0.0 1.0) (nth 2 (assoc p lst)) (nth 3 (assoc p lst)) (nth 4 (assoc p lst))) (assoc p lst) lst))
        )
        (if (and (= mm 1) (= nn n))
          (setq lst (subst (list p (nth 1 (assoc p lst)) (nth 2 (assoc p lst)) (list 0.0 0.0 1.0 1.0) (nth 4 (assoc p lst))) (assoc p lst) lst))
        )
        (if (and (= mm m) (= nn 1))
          (setq lst (subst (list p (nth 1 (assoc p lst)) (list 1.0 1.0 0.0 0.0) (nth 3 (assoc p lst)) (nth 4 (assoc p lst))) (assoc p lst) lst))
        )
        (if (and (= mm m) (= nn n))
          (setq lst (subst (list p (nth 1 (assoc p lst)) (nth 2 (assoc p lst)) (nth 3 (assoc p lst)) (list 0.0 1.0 1.0 0.0)) (assoc p lst) lst))
        )
      )
    )
    (reverse lst)
  )

  (vla-startundomark (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))))
  (prompt "\nPick OPEN edge drawn in CCW direction - 1st edge of NET...")
  (setq e1 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  (while (or (not e1) (vlax-curve-isclosed (ssname e1 0)))
    (prompt "\nMissed or picked curve isn't open... Please pick 1st edge again...")
    (setq e1 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  )
  (if e1
    (progn
      (setq e1 (ssname e1 0))
      (redraw e1 3)
    )
  )
  (prompt "\nPick OPEN edge drawn in CCW direction - 2nd edge of NET...")
  (setq e2 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  (while (or (not e2) (vlax-curve-isclosed (ssname e2 0)))
    (prompt "\nMissed or picked curve isn't open... Please pick 2nd edge again...")
    (setq e2 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  )
  (if e2
    (progn
      (setq e2 (ssname e2 0))
      (redraw e2 3)
    )
  )
  (prompt "\nPick OPEN edge drawn in CCW direction - 3rd edge of NET...")
  (setq e3 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  (while (or (not e3) (vlax-curve-isclosed (ssname e3 0)))
    (prompt "\nMissed or picked curve isn't open... Please pick 3rd edge again...")
    (setq e3 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  )
  (if e3
    (progn
      (setq e3 (ssname e3 0))
      (redraw e3 3)
    )
  )
  (prompt "\nPick OPEN edge drawn in CCW direction - 4th edge of NET...")
  (setq e4 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  (while (or (not e4) (vlax-curve-isclosed (ssname e4 0)))
    (prompt "\nMissed or picked curve isn't open... Please pick 4th edge again...")
    (setq e4 (ssget "_+.:E:S" '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,LINE"))))
  )
  (if e4
    (progn
      (setq e4 (ssname e4 0))
      (redraw e4 3)
    )
  )
  (initget 7)
  (setq m (getint "\nSpecify divisions in M direction : "))
  (while (= (rem m 2) 1)
    (prompt "\nM number must be even number - not odd... Please input M divisions again...")
    (initget 7)
    (setq m (getint "\nSpecify divisions in M direction : "))
  )
  (initget 7)
  (setq n (getint "\nSpecify divisions in N direction : "))
  (while (= (rem n 2) 1)
    (prompt "\nN number must be even number - not odd... Please input N divisions again...")
    (initget 7)
    (setq n (getint "\nSpecify divisions in N direction : "))
  )
  (initget 6)
  (setq ex (getreal "\nSpecify tension exponent <4.0> : "))
  (if (null ex)
    (setq ex 4.0)
  )
  (setq il '((1.0 0.0 0.0 1.0) (1.0 0.0 0.0 0.0) (1.0 1.0 0.0 0.0) (0.0 0.0 0.0 1.0) (0.5 0.5 0.5 0.5) (0.0 1.0 0.0 0.0) (0.0 0.0 1.0 1.0) (0.0 0.0 1.0 0.0) (0.0 1.0 1.0 0.0)))
  (setq de1 (/ (vlax-curve-getdistatparam e1 (vlax-curve-getendparam e1)) m))
  (setq de2 (/ (vlax-curve-getdistatparam e2 (vlax-curve-getendparam e2)) n))
  (setq de3 (/ (vlax-curve-getdistatparam e3 (vlax-curve-getendparam e3)) m))
  (setq de4 (/ (vlax-curve-getdistatparam e4 (vlax-curve-getendparam e4)) n))
  (setq lst (gridcoeff m n il ex))
  (setq mm 0)
  (repeat m
    (setq nn 0 mm (1+ mm))
    (repeat n
      (setq nn (1+ nn))
      (setq p (list mm nn))
      (setq kll (nth 1 (assoc p lst)) klr (nth 2 (assoc p lst)) kul (nth 3 (assoc p lst)) kur (nth 4 (assoc p lst)))
      (setq p1 (vlax-curve-getpointatdist e1 (* mm de1)))
      (setq p2 (vlax-curve-getpointatdist e2 (* nn de2)))
      (setq p3 (vlax-curve-getpointatdist e3 (* (- m mm) de3)))
      (setq p4 (vlax-curve-getpointatdist e4 (* (- n nn) de4)))
      (setq ur (mapcar '(lambda ( a b c d ) (/ (+ (* a (nth 0 kur)) (* b (nth 1 kur)) (* c (nth 2 kur)) (* d (nth 3 kur))) (+ (nth 0 kur) (nth 1 kur) (nth 2 kur) (nth 3 kur)))) p1 p2 p3 p4))
      (setq p1 (vlax-curve-getpointatdist e1 (* (1- mm) de1)))
      (setq p2 (vlax-curve-getpointatdist e2 (* (1- nn) de2)))
      (setq p3 (vlax-curve-getpointatdist e3 (* (1+ (- m mm)) de3)))
      (setq p4 (vlax-curve-getpointatdist e4 (* (1+ (- n nn)) de4)))
      (setq ll (mapcar '(lambda ( a b c d ) (/ (+ (* a (nth 0 kll)) (* b (nth 1 kll)) (* c (nth 2 kll)) (* d (nth 3 kll))) (+ (nth 0 kll) (nth 1 kll) (nth 2 kll) (nth 3 kll)))) p1 p2 p3 p4))
      (setq p1 (vlax-curve-getpointatdist e1 (* mm de1)))
      (setq p2 (vlax-curve-getpointatdist e2 (* (1- nn) de2)))
      (setq p3 (vlax-curve-getpointatdist e3 (* (- m mm) de3)))
      (setq p4 (vlax-curve-getpointatdist e4 (* (1+ (- n nn)) de4)))
      (setq lr (mapcar '(lambda ( a b c d ) (/ (+ (* a (nth 0 klr)) (* b (nth 1 klr)) (* c (nth 2 klr)) (* d (nth 3 klr))) (+ (nth 0 klr) (nth 1 klr) (nth 2 klr) (nth 3 klr)))) p1 p2 p3 p4))
      (setq p1 (vlax-curve-getpointatdist e1 (* (1- mm) de1)))
      (setq p2 (vlax-curve-getpointatdist e2 (* nn de2)))
      (setq p3 (vlax-curve-getpointatdist e3 (* (1+ (- m mm)) de3)))
      (setq p4 (vlax-curve-getpointatdist e4 (* (- n nn) de4)))
      (setq ul (mapcar '(lambda ( a b c d ) (/ (+ (* a (nth 0 kul)) (* b (nth 1 kul)) (* c (nth 2 kul)) (* d (nth 3 kul))) (+ (nth 0 kul) (nth 1 kul) (nth 2 kul) (nth 3 kul)))) p1 p2 p3 p4))
;;;      (entmake (list '(0 . "3DFACE") (cons 10 ll) (cons 11 lr) (cons 12 ur) (cons 13 ul)))
      (setq plst (cons ll plst))
      (if (= nn n)
        (setq plst (cons ul plst))
      )
      (if (= mm m)
        (setq pplst (cons lr pplst))
      )
      (if (and (= mm m) (= nn n))
        (setq pplst (cons ur pplst))
      )
    )
  )
  (foreach p (reverse pplst)
    (setq plst (cons p plst))
  )
  (setq pmsh (entmakex (list '(0 . "POLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolygonMesh") '(66 . 1) '(10 0.0 0.0 0.0) '(70 . 16) '(40 . 0.0) '(41 . 0.0) '(210 0.0 0.0 1.0) (cons 71 (1+ m)) (cons 72 (1+ n)) '(73 . 0) '(74 . 0) '(75 . 0))))
  (foreach p (reverse plst)
    (entmake (list '(0 . "VERTEX") '(100 . "AcDbEntity") '(100 . "AcDbVertex") '(100 . "AcDbPolygonMeshVertex") (cons 10 p) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(70 . 64) '(50 . 0.0) '(71 . 0) '(72 . 0) '(73 . 0) '(74 . 0)))
  )
  (entmake (list '(0 . "SEQEND") '(100 . "AcDbEntity") (cons -2 pmsh)))
  (*error* nil)
)

I hope you'll find it useful... If you are satisfied with solution you can mark it, but I've already explained, you already have built-in commands like EDGESURF, REVSURF, RULESURF and TABSURF and they all work in relation of changeable system variables SURFTAB1 for M density and SURFTAB2 for N density... BTW. I also don't have MPanel plugin for AutoCAD, so we are even at that issue...

Regards, all the best M.R.

[carlos_m_gil_p]

Hello how are you.

Thanks for always helping me.

I know those commands.
But the aim is to select the mesh and then the new mesh with the new features.

not have to be equal to MP anel. Apparently just a little.

You must maintain its four corners.

And the closest thing edges as possible.

Thank you.

[stevor]

This appears to handle the 4 sided meshes, not the 3s.

[marko_ribar]

---

@stevor wrote:
This appears to handle the 4 sided meshes, not the 3s.

---

Hi stevor, yes posted code is written that way that you can only pick entities (single) and if one edge is small enough, you may not choose it... So I've modified my routines to make it possible to select fair small enough edge - this means it will produce results like 3 edges algorithm... I'll attach my latest archive with some new variants and also the one big that was posted on theswamp also with included this modifications... Regards, M.R.

I hope you'll find my update somewhat useful...

[carlos_m_gil_p]

Hello how are you.

stevor

I could not use your lisp, I get an error.

Int_P Get_I C:PMT Sel Mesh:
Open Polygon mesh: Not Smoothed. bad argument type: VLA-OBJECT nil

marko_ribar

Thank you for these routines are very good.

You could adapt the lisp, to work selecting the polygon mesh and not select its edges.
And you can put any amount in the density of the mesh. It is working only if the amounts are pairs.

Again thank you very much.

[stevor]

Got an Error on my

Mesh-Mod-3DPoly-.LSP

I left out a Subr, subroutine, of course.

My guess is:
(Defun W_U (V) (trans V 0 1)) ; World to User
(Defun U_W (V) (trans V 1 0))

Add them to the top of  the .lsp file.

Hope that is not the only flaw.

I have not tried MR's file yet.

In general, note the error 'data,' and mention it.

[marko_ribar]

Just a slight little better NETWORK... Regards, M.R.

[marko_ribar]

More closer, but I think I can't do it more for now... M.R.

[marko_ribar]

Just FYI, you have new input at theswamp - look into the link I posted earlier... You have to be logged to access and download...