EDGESURF - help with lisp

marko_ribar · 发表于 2022-7-6 08:09:16

Hi all,
I've tried to make lisp for imitation of command edgesurf, but I wanted to make it more adequate to my obvious observation that middle points lie somewhere in between two central passing lines, but I can't debug it to be correct... Please look into DWG... Here is what I have so far...

copy

(defun mid ( p1 p2 ) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))(defun c:edgsurf ( / OSM MSP LI013 LI024 P013 P024 LI113 LI124 P113 P124  LI213 LI224 P213 P224 LI313 LI324 P313 P324 EDG1 EDG2 EDG3 EDG4 ENP1 ENP2 ENP3 ENP4 M N P0 P01 P02 P03 P04 P1 P11 P12 P13 P14 P2 P3 P31 P32 P33 P34 P4 ST1 ST2 STP1 STP2 STP3 STP4 ) (vl-load-com) (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq edg1 (car (entsel "\nPick first edge"))) (setq edg2 (car (entsel "\nPick second edge"))) (setq edg3 (car (entsel "\nPick third edge"))) (setq edg4 (car (entsel "\nPick fourth edge"))) (setq stp1 (vlax-curve-getstartpoint edg1)) (setq enp1 (vlax-curve-getendpoint edg1)) (setq stp2 (vlax-curve-getstartpoint edg2)) (setq enp2 (vlax-curve-getendpoint edg2)) (setq stp3 (vlax-curve-getstartpoint edg3)) (setq enp3 (vlax-curve-getendpoint edg3)) (setq stp4 (vlax-curve-getstartpoint edg4)) (setq enp4 (vlax-curve-getendpoint edg4)) (if (and (equal enp1 stp2 1e- (equal enp2 stp3 1e- (equal enp3 stp4 1e- (equal enp4 stp1 1e-)   (progn   (initget 6)   (setq st1 (getint "\nInput division in M direction : "))   (initget 6)   (setq st2 (getint "\nInput division in N direction : "))   (setq m -1 n -1)   (repeat (+ st1 1)     (setq m (1+ m))     (repeat (+ st2 1)       (setq n (1+ n))       (setq p01 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p02 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p03 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p04 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li013 (vla-addline msp (vlax-3d-point p01) (vlax-3d-point p03)))       (setq li024 (vla-addline msp (vlax-3d-point p04) (vlax-3d-point p02)))       (setq p013 (vlax-curve-getpointatparam li013 (* (float m) (/ (vlax-curve-getendparam li013) (float (+ st1 1))))))       (setq p024 (vlax-curve-getpointatparam li024 (* (float n) (/ (vlax-curve-getendparam li024) (float (+ st2 1))))))       (setq p0 (mid p013 p024))              (setq p11 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p12 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p13 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p14 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li113 (vla-addline msp (vlax-3d-point p11) (vlax-3d-point p13)))       (setq li124 (vla-addline msp (vlax-3d-point p14) (vlax-3d-point p12)))       (setq p113 (vlax-curve-getpointatparam li113 (* (float m) (/ (vlax-curve-getendparam li113) (float (+ st1 1))))))       (setq p124 (vlax-curve-getpointatparam li124 (* (float (+ n 1)) (/ (vlax-curve-getendparam li124) (float (+ st2 1))))))       (setq p1 (mid p113 p124))              (setq p21 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p22 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p23 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p24 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li213 (vla-addline msp (vlax-3d-point p21) (vlax-3d-point p23)))       (setq li224 (vla-addline msp (vlax-3d-point p24) (vlax-3d-point p22)))       (setq p213 (vlax-curve-getpointatparam li213 (* (float (+ m 1)) (/ (vlax-curve-getendparam li213) (float (+ st1 1))))))       (setq p224 (vlax-curve-getpointatparam li224 (* (float (+ n 1)) (/ (vlax-curve-getendparam li224) (float (+ st2 1))))))       (setq p2 (mid p213 p224))       (setq p31 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p32 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p33 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p34 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li313 (vla-addline msp (vlax-3d-point p31) (vlax-3d-point p33)))       (setq li324 (vla-addline msp (vlax-3d-point p34) (vlax-3d-point p32)))       (setq p313 (vlax-curve-getpointatparam li313 (* (float (+ m 1)) (/ (vlax-curve-getendparam li313) (float (+ st1 1))))))       (setq p324 (vlax-curve-getpointatparam li324 (* (float n) (/ (vlax-curve-getendparam li324) (float (+ st2 1))))))       (setq p3 (mid p313 p324))       (vl-cmdf "_.3dface" p0 p1 p2 p3)       (while (> (getvar 'cmdactive) 0) (vl-cmdf ""))       (vla-delete li013)       (vla-delete li024)       (vla-delete li113)       (vla-delete li124)       (vla-delete li213)       (vla-delete li224)       (vla-delete li313)       (vla-delete li324)            )   )   )   (princ "\nError : start-end vertex of edges missmatch") ) (setvar 'osmode osm) (princ))

Thanks, M.R.
surface - edgsurf.dwg

David Bethel · 发表于 2022-7-6 08:35:34

I must admit, I don't understand your needs. Edgesurf divides each edge entity equally based on SURFTAB1 & SURFTAB2 settings. The mesh edge vertices should be equally spaced. The interior points will vary but at a constant percentage of the total distance. Maybe I'm missing something. -David

marko_ribar · 发表于 2022-7-6 09:08:08

Here, I've debug it... It now works as expected, only it may skip some 3D faces around edges... So you may see what I was looking for - just start EDGSURF with my posted DWG...

copy

(defun mid ( p1 p2 ) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))(defun c:edgsurf ( / OSM MSP LI013 LI024 P013 P024 LI113 LI124 P113 P124  LI213 LI224 P213 P224 LI313 LI324 P313 P324 EDG1 EDG2 EDG3 EDG4 ENP1 ENP2 ENP3 ENP4 M N P0 P01 P02 P03 P04 P1 P11 P12 P13 P14 P2 P3 P31 P32 P33 P34 P4 ST1 ST2 STP1 STP2 STP3 STP4 ) (vl-load-com) (setq osm (getvar 'osmode)) (setvar 'osmode 0) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq edg1 (car (entsel "\nPick first edge"))) (setq edg2 (car (entsel "\nPick second edge"))) (setq edg3 (car (entsel "\nPick third edge"))) (setq edg4 (car (entsel "\nPick fourth edge"))) (setq stp1 (vlax-curve-getstartpoint edg1)) (setq enp1 (vlax-curve-getendpoint edg1)) (setq stp2 (vlax-curve-getstartpoint edg2)) (setq enp2 (vlax-curve-getendpoint edg2)) (setq stp3 (vlax-curve-getstartpoint edg3)) (setq enp3 (vlax-curve-getendpoint edg3)) (setq stp4 (vlax-curve-getstartpoint edg4)) (setq enp4 (vlax-curve-getendpoint edg4)) (if (and (equal enp1 stp2 1e- (equal enp2 stp3 1e- (equal enp3 stp4 1e- (equal enp4 stp1 1e-)   (progn   (initget 6)   (setq st1 (getint "\nInput division in M direction : "))   (initget 6)   (setq st2 (getint "\nInput division in N direction : "))   (setq m -1 n -1)   (repeat (+ st1 1)     (setq m (1+ m))     (repeat (+ st2 1)       (setq n (1+ n))       (setq p01 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p02 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p03 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p04 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li013 (vla-addline msp (vlax-3d-point p01) (vlax-3d-point p03)))       (setq li024 (vla-addline msp (vlax-3d-point p04) (vlax-3d-point p02)))       (setq p013 (vlax-curve-getpointatparam li013 (* (float n) (/ (vlax-curve-getendparam li013) (float (+ st2 1))))))       (setq p024 (vlax-curve-getpointatparam li024 (* (float m) (/ (vlax-curve-getendparam li024) (float (+ st1 1))))))       (setq p0 (mid p013 p024))              (setq p11 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p12 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p13 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p14 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li113 (vla-addline msp (vlax-3d-point p11) (vlax-3d-point p13)))       (setq li124 (vla-addline msp (vlax-3d-point p14) (vlax-3d-point p12)))       (setq p113 (vlax-curve-getpointatparam li113 (* (float n) (/ (vlax-curve-getendparam li113) (float (+ st2 1))))))       (setq p124 (vlax-curve-getpointatparam li124 (* (float (+ m 1)) (/ (vlax-curve-getendparam li124) (float (+ st1 1))))))       (setq p1 (mid p113 p124))              (setq p21 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p22 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p23 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p24 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li213 (vla-addline msp (vlax-3d-point p21) (vlax-3d-point p23)))       (setq li224 (vla-addline msp (vlax-3d-point p24) (vlax-3d-point p22)))       (setq p213 (vlax-curve-getpointatparam li213 (* (float (+ n 1)) (/ (vlax-curve-getendparam li213) (float (+ st2 1))))))       (setq p224 (vlax-curve-getpointatparam li224 (* (float (+ m 1)) (/ (vlax-curve-getendparam li224) (float (+ st1 1))))))       (setq p2 (mid p213 p224))       (setq p31 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p32 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p33 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p34 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li313 (vla-addline msp (vlax-3d-point p31) (vlax-3d-point p33)))       (setq li324 (vla-addline msp (vlax-3d-point p34) (vlax-3d-point p32)))       (setq p313 (vlax-curve-getpointatparam li313 (* (float (+ n 1)) (/ (vlax-curve-getendparam li313) (float (+ st2 1))))))       (setq p324 (vlax-curve-getpointatparam li324 (* (float m) (/ (vlax-curve-getendparam li324) (float (+ st1 1))))))       (setq p3 (mid p313 p324))       (vl-cmdf "_.3dface" p0 p1 p2 p3)       (while (> (getvar 'cmdactive) 0) (vl-cmdf ""))       (vla-delete li013)       (vla-delete li024)       (vla-delete li113)       (vla-delete li124)       (vla-delete li213)       (vla-delete li224)       (vla-delete li313)       (vla-delete li324)            )     (setq n -1)   )   )   (princ "\nError : start-end vertex of edges missmatch") ) (setvar 'osmode osm) (princ))

Thanks, and best wishes, M.R.

marko_ribar · 发表于 2022-7-6 09:24:29

Here is my last revision of code - tested on A2012 and

copy

(defun mid ( p1 p2 ) (mapcar '(lambda (p1 p2) (/ (+ p1 p2) 2.0)) p1 p2))(defun c:edgsurf ( / OSM MSP LI013 LI024 P013 P024 LI113 LI124 P113 P124  LI213 LI224 P213 P224 LI313 LI324 P313 P324 EDG1 EDG2 EDG3 EDG4 ENP1 ENP2 ENP3 ENP4 M N P0 P01 P02 P03 P04 P1 P11 P12 P13 P14 P2 P3 P31 P32 P33 P34 P4 ST1 ST2 STP1 STP2 STP3 STP4 ) (vl-load-com) (setq osm (getvar 'osmode)) (vl-cmdf "osnap" "off") (setvar 'osmode 0) (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (setq edg1 (car (entsel "\nPick first edge"))) (setq edg2 (car (entsel "\nPick second edge"))) (setq edg3 (car (entsel "\nPick third edge"))) (setq edg4 (car (entsel "\nPick fourth edge"))) (setq stp1 (vlax-curve-getstartpoint edg1)) (setq enp1 (vlax-curve-getendpoint edg1)) (setq stp2 (vlax-curve-getstartpoint edg2)) (setq enp2 (vlax-curve-getendpoint edg2)) (setq stp3 (vlax-curve-getstartpoint edg3)) (setq enp3 (vlax-curve-getendpoint edg3)) (setq stp4 (vlax-curve-getstartpoint edg4)) (setq enp4 (vlax-curve-getendpoint edg4)) (if (and (equal enp1 stp2 1e- (equal enp2 stp3 1e- (equal enp3 stp4 1e- (equal enp4 stp1 1e-)   (progn   (initget 6)   (setq st1 (getint "\nInput division in M direction : "))   (initget 6)   (setq st2 (getint "\nInput division in N direction : "))   (setq m -1 n -1)   (repeat (+ st1 1)     (setq m (1+ m))     (repeat (+ st2 1)       (setq n (1+ n))       (setq p01 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p02 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p03 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p04 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li013 (vla-addline msp (vlax-3d-point p01) (vlax-3d-point p03)))       (setq li024 (vla-addline msp (vlax-3d-point p04) (vlax-3d-point p02)))       (setq p013 (vlax-curve-getpointatparam li013 (* (float n) (/ (vlax-curve-getendparam li013) (float (+ st2 1))))))       (if (eq p013 nil) (setq p013 (vlax-curve-getpointatparam li013 (vlax-curve-getendparam li013))))       (setq p024 (vlax-curve-getpointatparam li024 (* (float m) (/ (vlax-curve-getendparam li024) (float (+ st1 1))))))       (if (eq p024 nil) (setq p024 (vlax-curve-getpointatparam li024 (vlax-curve-getendparam li024))))       (setq p0 (mid p013 p024))              (setq p11 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p12 (vlax-curve-getpointatparam edg2 (* (float n) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p13 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p14 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) n)) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li113 (vla-addline msp (vlax-3d-point p11) (vlax-3d-point p13)))       (setq li124 (vla-addline msp (vlax-3d-point p14) (vlax-3d-point p12)))       (setq p113 (vlax-curve-getpointatparam li113 (* (float n) (/ (vlax-curve-getendparam li113) (float (+ st2 1))))))       (if (eq p113 nil) (setq p113 (vlax-curve-getpointatparam li113 (vlax-curve-getendparam li113))))       (setq p124 (vlax-curve-getpointatparam li124 (* (float (+ m 1)) (/ (vlax-curve-getendparam li124) (float (+ st1 1))))))       (if (eq p124 nil) (setq p124 (vlax-curve-getpointatparam li124 (vlax-curve-getendparam li124))))       (setq p1 (mid p113 p124))              (setq p21 (vlax-curve-getpointatparam edg1 (* (float (+ m 1)) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p22 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p23 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) (+ m 1))) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p24 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li213 (vla-addline msp (vlax-3d-point p21) (vlax-3d-point p23)))       (setq li224 (vla-addline msp (vlax-3d-point p24) (vlax-3d-point p22)))       (setq p213 (vlax-curve-getpointatparam li213 (* (float (+ n 1)) (/ (vlax-curve-getendparam li213) (float (+ st2 1))))))       (if (eq p213 nil) (setq p213 (vlax-curve-getpointatparam li213 (vlax-curve-getendparam li213))))       (setq p224 (vlax-curve-getpointatparam li224 (* (float (+ m 1)) (/ (vlax-curve-getendparam li224) (float (+ st1 1))))))       (if (eq p224 nil) (setq p224 (vlax-curve-getpointatparam li224 (vlax-curve-getendparam li224))))       (setq p2 (mid p213 p224))       (setq p31 (vlax-curve-getpointatparam edg1 (* (float m) (/ (vlax-curve-getendparam edg1) (float (+ st1 1))))))       (setq p32 (vlax-curve-getpointatparam edg2 (* (float (+ n 1)) (/ (vlax-curve-getendparam edg2) (float (+ st2 1))))))       (setq p33 (vlax-curve-getpointatparam edg3 (* (float (- (+ st1 1) m)) (/ (vlax-curve-getendparam edg3) (float (+ st1 1))))))       (setq p34 (vlax-curve-getpointatparam edg4 (* (float (- (+ st2 1) (+ n 1))) (/ (vlax-curve-getendparam edg4) (float (+ st2 1))))))       (setq li313 (vla-addline msp (vlax-3d-point p31) (vlax-3d-point p33)))       (setq li324 (vla-addline msp (vlax-3d-point p34) (vlax-3d-point p32)))       (setq p313 (vlax-curve-getpointatparam li313 (* (float (+ n 1)) (/ (vlax-curve-getendparam li313) (float (+ st2 1))))))       (if (eq p313 nil) (setq p313 (vlax-curve-getpointatparam li313 (vlax-curve-getendparam li313))))       (setq p324 (vlax-curve-getpointatparam li324 (* (float m) (/ (vlax-curve-getendparam li324) (float (+ st1 1))))))       (if (eq p324 nil) (setq p324 (vlax-curve-getpointatparam li324 (vlax-curve-getendparam li324))))       (setq p3 (mid p313 p324))       (vl-cmdf "_.3dface" p0 p1 p2 p3)       (while (> (getvar 'cmdactive) 0) (vl-cmdf ""))       (vla-delete li013)       (vla-delete li024)       (vla-delete li113)       (vla-delete li124)       (vla-delete li213)       (vla-delete li224)       (vla-delete li313)       (vla-delete li324)            )     (setq n -1)   )   )   (princ "\nError : start-end vertex of edges missmatch") ) (setvar 'osmode osm) (princ))

M.R.

[编程交流] EDGESURF - help with lisp

发表回复

精选推荐