(defun c:nr ()
;;;判断内形加工最小的R
(setq pan nil
谢谢前辈！这段程序老提示没有选到合适对象。 (defun c:nr ()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;判断内形加工最小的R
;;;(setq pan nil
;;; wpl nil
;;;)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun nnr ()
(setq pan nil
wpl nil
)
(setq r-list (list 100))
;;; (setq Wr-list (list 100))
(IF (Pldir (plinexy PeN))
(SETQ XXX 1.5)
(SETQ xxx 0.5)
) ;xxx=1.5 为逆时针
(PrinC "\n这是对 LWPolyLine 进行数据分析的基本程序...")
(SetQ pel (EntGet pen) ;取出对象数据表
pel (Member '(100 . "AcDbPolyline") pel) ;取出其中的有关数据
pln (Cdr (Assoc 90 pel)) ;取出控制点数量
ptp (Cdr (Assoc 70 pel)) ;取出结束片段类型
)
(SetQ pan 1 ;6 ;数据读取序号初值
wpl '() ;自建的点位数据表
rl0
)
(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)) ;序号步进
)
(SetQ ; rl(Length wpl)
wpl (Cons (Last wpl) wpl) ;加入封闭点
wpl (Reverse wpl) ;整理WPL表
pn0
)
(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))
(if (= xxx 1.5)
(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))
;半径计算
)
(ENTMAKE
(LIST
(CONS 0 "TEXT")
(Cons 7 "hz")
(cons 8 "OURSFHMB")
(cons 62
(if (< (abs RR) 0.15)
1
7
)
)
(cons 10 np)
(cons 40 0.2)
(cons 1 (strcat "R" (rtos (abs RR) 2 3)))
(cons 50 0.0)
(cons 41 0.7)
)
)
(setq r-list (cons (abs rr) r-list))
)
) ;"逆时针";弧度>0为内弧，<0为外弧
)
(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))
;半径计算
)
(ENTMAKE
(LIST
(CONS 0 "TEXT")
(Cons 7 "hz")
(cons 8 "OURSFHMB")
(cons 62
(if (< (abs RR) 0.15)
1
7
)
)
(cons 10 np)
(cons 40 0.2)
(cons 1 (strcat "R" (rtos (abs RR) 2 3)))
(cons 50 0.0)
(cons 41 0.7)
)
)
(setq r-list (cons (abs rr) r-list))
)
) ;"顺时针",弧度<0为内弧，>0为外弧
)
)
(SetQ pn (1+ pn)) ;搜索序号步进
)
(PrinC)
)
(while (setq en (entsel "\n 选择闭合多线段"))
(setq PeN (car en))
(cond
((wcmatch (cdr (assoc 0 (entget PeN))) "*POLYLINE")
(nnr)
)
(t (prompt "\n 没有选择到合适的实体:__"))
)
(setq en nil)
)
(princ
"\n **Works For Qiany**13764852693@139.comc:Nr for ffh..<PLINRE内形最小内R> -"
)
(princ)
) andyding 发表于 2020-9-25 17:17
谢谢前辈！这段程序老提示没有选到合适对象。
你CAD 的版本为多少？ 前生 发表于 2020-9-26 00:15
你CAD 的版本为多少？
我用的2020版的 本帖最后由 andyding 于 2020-10-29 11:25 编辑
前生 发表于 2020-9-26 00:14
(defun c:nr ()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun Pldir (pts)
前辈，这段程序已经嵌入进去了，可以识别内形最小R。
之前我忽略了一个问题，如果是冲子或者成型零件，要识别外形最小内R，识别的R与现程序刚好相反。用现有这段程序要怎么改才能识别？
再次求助，请赐教！
已经搞好了。谢谢！
这个好像挺有用的
页:
1
[2]