- 积分
- 15313
- 明经币
- 个
- 注册时间
- 2002-2-9
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2020-8-16 16:13:00
|
显示全部楼层
(defun c:nr ()
;;;判断内形加工最小的R
(setq pan nil
wpl nil
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun nnr ()
(setq r-list (list 100))
(setq Wr-list (list 100))
(PrinC "\n这是对 LWPolyLine 进行数据分析的基本程序...")
(SetQ pel (EntGet pen) ;取出对象数据表
pel (Member '(100 . "AcDbPolyline") pel) ;取出其中的有关数据
pln (Cdr (Assoc 90 pel)) ;取出控制点数量
ptp (Cdr (Assoc 70 pel)) ;取出结束片段类型
)
(SetQ pan 6 ;数据读取序号初值
wpl '() ;自建的点位数据表
rl 0
)
(while (setq plist (nth pan pel))
(if (= 10 (car plist))
(SetQ plp (Cdr (Nth pan pel)) ;取出控制点点位
par (Cdr (Nth (+ 3 pan) pel)) ;取出弓弦比
wpl (Cons (List plp par) wpl) ;将数据加到WPL表中
rl (1+ rl)
)
)
(SetQ pan (+ 1 pan)) ;序号步进
;;; (princ rl)(princ "\n")
)
(SetQ ; rl (Length wpl)
wpl (Cons (Last wpl) wpl) ;加入封闭点
wpl (Reverse wpl) ;整理WPL表
pn 0
)
(SetQ clk (If (Or (= 0 ptp) (= 128 ptp))
"开口"
"封闭"
)
) ;判断封闭与口
(Repeat (If (= "开口" clk)
(- rl 1)
rl
) ;逐点分析
(SetQ al (Nth pn wpl) ;取出点数据表
pt (Car al) ;取出点位
)
(if (Pldir (plinexy PeN))
(PROGN
(If (And (> (Cadr al) 0.0) (Nth pn wpl)) ;如果是弧片断
(Progn (SetQ gx (Cadr al) ;取出弓比
bj (* (ATAN (ABS gx)) 4) ;计算包角
np (Car (Nth (1+ pn) wpl)) ;取出下一点位
xc (* 0.5 (Distance pt np)) ;半弦长计算
gg (* gx xc) ;弓高计算
rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
;半径计算
)
(setq r-list (cons (abs rr) r-list))
)
) ;"逆时针";弧度>0为内弧,<0为外弧
(If (And (< (Cadr al) 0.0) (Nth pn wpl)) ;如果是弧片断
(Progn (SetQ gx (Cadr al) ;取出弓比
bj (* (ATAN (ABS gx)) 4) ;计算包角
np (Car (Nth (1+ pn) wpl)) ;取出下一点位
xc (* 0.5 (Distance pt np)) ;半弦长计算
gg (* gx xc) ;弓高计算
rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
;半径计算
)
(setq Wr-list (cons (abs rr) Wr-list))
)
)
(if (< (abs rr) 0.15)
(ENTMAKE
(LIST
(CONS 0 "TEXT")
(Cons 7 "hz")
(cons 8 "OURSFHMB")
(cons 62 101)
(cons
10
np
)
(cons 40 0.2)
(cons
1
(strcat "R" (rtos (abs RR) 2 3))
)
(cons 50 0.0)
(cons 41 0.7)
)
)
)
)
(PROGN
(If (And (< (Cadr al) 0.0) (Nth pn wpl)) ;如果是弧片断
(Progn (SetQ gx (Cadr al) ;取出弓比
bj (* (ATAN (ABS gx)) 4) ;计算包角
np (Car (Nth (1+ pn) wpl)) ;取出下一点位
xc (* 0.5 (Distance pt np)) ;半弦长计算
gg (* gx xc) ;弓高计算
rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
;半径计算
)
(setq r-list (cons (abs rr) r-list))
)
) ;"顺时针",弧度<0为内弧,>0为外弧
(If (And (> (Cadr al) 0.0) (Nth pn wpl)) ;如果是弧片断
(Progn (SetQ gx (Cadr al) ;取出弓比
bj (* (ATAN (ABS gx)) 4) ;计算包角
np (Car (Nth (1+ pn) wpl)) ;取出下一点位
xc (* 0.5 (Distance pt np)) ;半弦长计算
gg (* gx xc) ;弓高计算
rr (/ (+ (* xc xc) (* gg gg)) (* 2 gg))
;半径计算
)
(setq Wr-list (cons (abs rr) Wr-list))
)
)
(if (< (abs rr) 0.15)
(ENTMAKE
(LIST
(CONS 0 "TEXT")
(Cons 7 "hz")
(cons 8 "OURSFHMB")
(cons 62 101)
(cons
10
np
;;; (polar pn (angle pn np) (* 0.5 (distance pn np)))
)
(cons 40 0.2)
(cons
1
(strcat "R" (rtos (abs RR) 2 3))
)
(cons 50 0.0)
(cons 41 0.7)
)
)
)
)
)
(SetQ pn (1+ pn)) ;搜索序号步进
)
;;; (IF (> (length r-list) 1)
;;; (progn
;;; (ENTMAKE
;;; (LIST
;;; (CONS 0 "TEXT")
;;; (Cons 7 "hz")
;;; (cons 8 "OURSFHMB")
;;; (cons 62 101)
;;; (cons
;;; 10
;;; (trans
;;; (getpoint (trans (car (last wpl)) 0 1)
;;; "\n 请点取点标注内形,最小内R"
;;; )
;;; 1
;;; 0
;;; )
;;; )
;;; (cons 40 1)
;;; (cons
;;; 1
;;; (strcat "内形,最小内R "
;;; (vl-prin1-to-string (nth 0 (vl-sort r-list '<)))
;;; )
;;; )
;;; (cons 50 0.0)
;;; (cons 41 0.7)
;;; )
;;; )
;;; )
;;; )
;;; (IF (> (length wr-list) 1)
;;; (progn
;;; (ENTMAKE
;;; (LIST
;;; (CONS 0 "TEXT")
;;; (Cons 7 "hz")
;;; (cons 8 "OURSFHMB")
;;; (cons 62 2)
;;; (cons
;;; 10
;;; (trans
;;; (getpoint (trans (car (last wpl)) 0 1)
;;; "\n 请点取点标注外形,最小内R"
;;; )
;;; 1
;;; 0
;;; )
;;; )
;;; (cons 40 1)
;;; (cons
;;; 1
;;; (strcat " 外形,最小内R "
;;; (vl-prin1-to-string (nth 0 (vl-sort wr-list '<)))
;;; )
;;; )
;;; (cons 50 0.0)
;;; (cons 41 0.7)
;;; )
;;; )
;;; (princ
;;; (strcat "最小外半径为R "
;;; (vl-prin1-to-string (nth 0 (vl-sort wr-list '<)))
;;; "顺时针"
;;; )
;;; )
;;; )
;;; )
(PrinC)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Pldir (pts)
(< (apply
'+
(mapcar
'(lambda (x y) (- (* (car x) (cadr y)) (* (car y) (cadr x))))
pts
(append (cdr pts) (list (car pts)))
)
)
0
)
)
(defun plinexy (e / p i)
(setq i -1)
(mapcar (function (lambda (x) (list (car x) (cadr x))))
(reverse (repeat (fix (1+ (vlax-curve-getEndParam e)))
(setq i (1+ i)
p (cons (vlax-curve-getPointAtParam e i) p)
)
)
)
)
(if (equal (car p) (last p))
(reverse (cdr (reverse p)))
p
)
)
;;; (if (setq PeN (car(entsel "\n 选择闭合多线段")))
(while (setq en (entsel "\n 选择闭合多线段"))
(setq PeN (car en))
(cond
((wcmatch (cdr (assoc 0 (entget PeN))) "*POLYLINE")
(nnr)
)
(t (prompt "\n 没有选择到合适的实体:__"))
)
(prompt "\n 没有选择到合适的实体:__")
)
(princ
"\n 13764852693@139.com ** ** c:Nr for ffh- <PLINRE内形最小内R> -"
)
(princ)
) |
|