马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 lgx9612 于 2014-8-12 19:14 编辑
来点实用的,求spline线的最小包容盒子,通常vla-getboundingbox来做spline线的最小包容盒子是会出错的,就如附图的cad曲线用vla-getboundingbox就错了.
- (defun c:test(/ cm_lgx ucs_lgx os_lgx ss_lgx llpoint)
- ;;;by: 刘国新
- (setq cm_lgx (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (setq ucs_lgx (getvar "ucsorg"))
- (command "ucs" "w")
- (setq os_lgx (getvar "osmode"))
- (setvar "osmode" 0)
- (setq ss_lgx (car (entsel "请选择spline曲线")))
- (setq llpoint (calspline_lgx ss_lgx))
- (command "rectang" (car llpoint) (cadr llpoint))
- (setvar "osmode" os_lgx)
- (command "ucs" "n" ucs_lgx)
- (setvar "cmdecho" cm_lgx)
- )
- (defun calspline_lgx (partname_lgx / pl-temp_min_point pl-temp_max_point p_lgx
- lowest bbb p1_lgx p_lgx vla-object zzl givenPnt type_lgx
- y2 y1 x1 x2 llpoint urpoint pl_min_point pl_max_point)
- ;;;原创,编写: 刘国新
- ;;;精密计算spline线的最小包容盒子
- (setq bbb (entget partname_lgx))
- (while (/= (assoc 10 bbb) nil)
- (setq p1_lgx (assoc 10 bbb))
- (setq p_lgx (cons (cdr p1_lgx) p_lgx))
- (setq bbb (vl-remove p1_lgx bbb))
- )
- (setq pl-temp_min_point (apply 'mapcar (cons 'min p_lgx)))
- (setq pl-temp_max_point (apply 'mapcar (cons 'max p_lgx)))
- (setq pl-temp_min_point (list (- (car pl-temp_min_point) 3)(- (cadr pl-temp_min_point) 3)))
- (setq pl-temp_max_point (list (+ (car pl-temp_max_point) 3)(+ (cadr pl-temp_max_point) 3)))
- (setq vla-object(vlax-ename->vla-object partname_lgx))
- (progn
- (setq pl_min_point pl-temp_min_point)
- (setq pl_max_point pl-temp_max_point)
- (setq zzl (/ (- (car pl_max_point)(car pl_min_point)) 10))
- (setq givenPnt (list (car pl_min_point)(cadr pl_max_point)))
- (setq y2 (calculate_lgx vla-object givenPnt "y" zzl pl_min_point pl_max_point))
- )
- (progn
- (setq pl_min_point pl-temp_min_point)
- (setq pl_max_point (list (car pl-temp_max_point)(cadr pl-temp_min_point)))
- (setq zzl (/ (- (car pl_max_point)(car pl_min_point)) 10))
- (setq givenPnt (list (car pl_min_point)(cadr pl_max_point)))
- (setq y1 (calculate_lgx vla-object givenPnt "y" zzl pl_min_point pl_max_point))
- )
- (progn
- (setq pl_min_point pl-temp_min_point)
- (setq pl_max_point (list (car pl-temp_min_point)(cadr pl-temp_max_point)))
- (setq zzl (/ (- (cadr pl_max_point)(cadr pl_min_point)) 10))
- (setq givenPnt pl_min_point)
- (setq x1 (calculate_lgx vla-object givenPnt "x" zzl pl_min_point pl_max_point))
- )
- (progn
- (setq pl_min_point (list (car pl-temp_max_point)(cadr pl-temp_min_point)))
- (setq pl_max_point pl-temp_max_point)
- (setq zzl (/ (- (cadr pl_max_point)(cadr pl_min_point)) 10))
- (setq givenPnt pl_min_point)
- (setq x2 (calculate_lgx vla-object givenPnt "x" zzl pl_min_point pl_max_point))
- )
- (setq llpoint (list (car x1) (cadr y1)))
- (setq urpoint (list (car x2) (cadr y2)))
- (setq llpoint (list llpoint urpoint))
- llpoint
- )
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun calculate_lgx(vla-object givenPnt type_lgx zzl pl_min_point pl_max_point / topnt lowest lowestpoint )
- ;;;原创,编写: 刘国新
- ;;;分四边精密求出最小包容盒子
- (while (>= zzl 0.02)
- (repeat 11
- (setq topnt (vlax-curve-getClosestPointTo vla-object givenPnt))
- ;;;(command "line" givenPnt topnt "")
- (if (or (>= lowest (distance givenPnt topnt)) (= lowest nil))
- (progn
- (setq lowest (distance givenPnt topnt))
- (setq lowestpoint givenPnt)
- )
- )
- (if (= type_lgx "y")
- (setq givenPnt (list (+ (car givenPnt) zzl)(cadr pl_max_point)))
- (setq givenPnt (list (car pl_min_point)(+ (cadr givenPnt) zzl)))
- )
- )
- (if (= type_lgx "y")
- (setq givenPnt (list (- (car lowestpoint) zzl) (cadr pl_max_point)))
- (setq givenPnt (list (car pl_min_point) (- (cadr lowestpoint) zzl)))
- )
- (setq zzl (/ zzl 5))
- )
- (setq topnt (vlax-curve-getClosestPointTo vla-object lowestpoint ))
- topnt
- )
|