求等高线成批内插程序

枪花不凋谢

是lisp文件吗??

杜阳

rark123 发表于 2007-1-24 18:25
我手里有个 自己做的 但不是批量的 而且还存在一些问题 不过 还可以使用 要的话 邮件联系cl9829_06@163.com

你好 版主  可以发一份内插的吗   276610952@qq.com
谢谢

QQ873240166

人才人才真是人才

czb203

好的，非常好的

13648893846

(defun Lc:DgxInterpolateElevationpoint (pt ss / K PL NAME PZX P2 KK NAME1 PZX1 PZX2 PZX3 GCC JULI1 JULI2 BZ XGC XZB)        (if ss                (progn                        (setq k -1)                        (setq pl '())                        (repeat (sslength ss)                                (setq Name   (ssname ss (setq k (1+ k))))                                (setq pzx (distance (vl-remove  (last pt) pt)  (vl-remove  (last (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name) PT [extend])) (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name) PT [extend]))))                                (setq pl (append pl (list pzx)))                        )                         (setq p2 (vl-sort pl '<))                )        )        (if ss                (progn                        (setq kk -1)                        (repeat (sslength ss)                                (setq Name1 (ssname ss (setq kk (1+ kk))))                                (setq pzx1(distance (vl-remove  (last pt) pt)  (vl-remove  (last (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT [extend])) (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT [extend]))))                                (cond                                        ((equal (car p2) pzx1 0.001)                                                 (setq pzx2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT [extend]))                                                                                        )                                        ((equal (cadr p2) pzx1 0.001)                                                 (setq pzx3 (vlax-curve-getClosestPointTo (vlax-ename->vla-object Name1) PT [extend]))                                                                                        )                                                                        )                                                        )                        (setq gcc (- (last pzx2) (last pzx3)))                        (setq juli1 (distance (vl-remove (last pzx2) pzx2) (vl-remove (last pzx3) pzx3)))                        (setq juli2 (distance (vl-remove (last pt) pt) (vl-remove (last pzx3) pzx3)))                        (setq bz (/ gcc juli1))                        (setq xgc (+ (last pzx3)(* bz juli2)))                        (setq xzb (list (car pt) (cadr pt) xgc))                )        )        xzb        )