不知道lisp里有没有求极值点的函数
自贡黄明儒 发表于 2014-7-16 20:41 static/image/common/back.gif
你用了whi|e，是不是逼近法。G版写的那个更简洁
while是计算的密度,也算是是逼近法.昨天在网上逛逛,得知兄弟是个大师,失敬!在此之前我一直都找关于spline曲线的最小包容盒子的计算但没有找到,不知G版写的那个更简洁的程序在哪,想学习学习(可否贴上代码?).我知道标准计算(vla-getboundingbox)对spline曲线和图块并不好.所以绞尽脑汁,出此下策,写出如此代码,多多指教.
本帖最后由 Gu_xl 于 2014-7-18 13:15 编辑
;;(gxl-GetCurveBox curve) 精确取得曲线实体外矩形框对角点
;;2014.07.18 修正1阶SPLINE的错误
(defun gxl-GetCurveBox (curve / obj p1 p2 p3 p4 lst pts)
(if (= 'ename (type curve))
(setq obj (vlax-ename->vla-object curve))
(setq obj curve)
)
(if (and (= "AcDbSpline" (vla-get-objectname obj))
(< (vla-get-Degree obj) 2)
)
(progn
(setq pl (vlax-safearray->list
(vlax-variant-value (vla-get-ControlPoints obj))
)
)
(while pl
(setq pts (cons (list (car pl) (cadr pl) (caddr pl)) pts)
pl(cdddr pl)
)
)
(setq p1 (apply 'mapcar (cons 'min pts))
p3 (apply 'mapcar (cons 'max pts))
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
)
(progn
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
)
)
(SETQ lst
(mapcar '(lambda (a b)
(vlax-curve-getClosestPointToProjection curve a b t)
)
(list p1 p2 p3 p4)
'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
)
)
(list
(apply 'mapcar (cons 'min lst))
(apply 'mapcar (cons 'max lst))
)
)
Gu_xl 发表于 2014-7-17 14:18 static/image/common/back.gif
Gu_xl兄弟,非常感谢你的代码,很多高级的函数我都不会,你的程序确实很值得我学习,但spline的情况很多,只要vla-getboundingbox得出的最小及最大没有包住曲线就不能得出最正确的结果.之前我做按区域自动生成块的程序时就这个困扰我很久,spline放大或缩小都会有不同的结果,可能是我的cad版本问题,附上我试验代码gif和cad图档.
本着学习的态度向你请教,试验代码并不是次次正确,我是不是哪里错了?
lgx9612 发表于 2014-7-17 19:51 static/image/common/back.gif
Gu_xl兄弟,非常感谢你的代码,很多高级的函数我都不会,你的程序确实很值得我学习,但spline ...
你是要考我眼力吗？太花，看不明白你的意思！
本帖最后由 lgx9612 于 2014-7-17 20:45 编辑
Gu_xl 发表于 2014-7-17 20:10 static/image/common/back.gif
你是要考我眼力吗？太花，看不明白你的意思！
在这个图中不能得出正确包容盒子我只是在你的代码中加了一句
(command "rectang" (apply 'mapcar (cons 'min lst)) (apply 'mapcar (cons 'max lst)))
(gxl-GetCurveBox (car (entsel)))执行(defun gxl-GetCurveBox (curve / obj p1 p2 p3 p4 lst)
(if (= 'ename (type curve))
(setq obj (vlax-ename->vla-object curve))
(setq obj curve)
)
(vla-GetBoundingBox obj 'p1 'p3)
(setq p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3)
p2 (list (car p1) (cadr p3) (caddr p1))
p4 (list (car p3) (cadr p1) (caddr p1))
)
(SETQ lst
(mapcar '(lambda (a b)
(vlax-curve-getClosestPointToProjection curve a b t))
(list p1 p2 p3 p4)
'((1.0 0 0) (0 -1.0 0) (-1.0 0 0) (0 1.0 0))
)
)
(list
(apply 'mapcar (cons 'min lst))
(apply 'mapcar (cons 'max lst))
)
(command "rectang" (apply 'mapcar (cons 'min lst)) (apply 'mapcar (cons 'max lst)))
)
cad那个函数有一定的误差，如果向外偏移个百分之五左右不知道能不能在这种情况下补救一下
风树 发表于 2014-7-17 21:29 static/image/common/back.gif
cad那个函数有一定的误差，如果向外偏移个百分之五左右不知道能不能在这种情况下补救一下
这个函数对spline线和图块毫无能力
lgx9612 发表于 2014-7-17 20:32 static/image/common/back.gif
在这个图中不能得出正确包容盒子我只是在你的代码中加了一句
(command "rectang" (apply 'mapcar (con ...
G版挺高级的一个函数，运行正确无误，被你加了一句command代码给糟蹋了！