选择集内圆弧半径统计

前生

很多代码是坛子里的，我们是搬运工

andyding

前生 发表于 2020-8-16 16:13
(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 '()                        ;  自建的点位数据表
          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))                ;序号步进
    )
    (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))
      (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.com  c:Nr for ffh..<PLINRE内形最小内R> -"
  )
  (princ)
)

前生

andyding 发表于 2020-9-25 17:17
谢谢前辈！这段程序老提示没有选到合适对象。

你CAD 的版本为多少？

andyding

前生 发表于 2020-9-26 00:15
你CAD 的版本为多少？

我用的2020版的

andyding

前生 发表于 2020-9-26 00:14
(defun c:nr ()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun Pldir (pts)

前辈，这段程序已经嵌入进去了，可以识别内形最小R。
之前我忽略了一个问题，如果是冲子或者成型零件，要识别外形最小内R，识别的R与现程序刚好相反。用现有这段程序要怎么改才能识别？
再次求助，请赐教！


已经搞好了。谢谢！

迷失1786

这个好像挺有用的