寻求大神帮忙写一个简单的程序（谢谢）

xudongchu

本人做钣金模具设计，产品展开用的很多，请大神帮忙按照图片上的功能要求，写一个简单的程序。不胜感激。

xudongchu

补偿量手动输入之后，展开曲线自动外移。谢谢 大神帮忙看下 或者指点一下。谢谢

水吉空

定制开发请到付费开发区。

前生

内侧线要连成pline.
计算每段长,加补偿。冲压件的展开。

前生

很久以前的一个老程序。写的啰嗦，也懒的弄了
(Defun C:ar1 ()
;;;*****************************
  (defun object        ()
    (vl-load-com)
    (setq mp (vla-get-modelspace
               (vla-get-activedocument (vlax-get-acad-object))
             )
    )
  )
;;;*****************************
  (Defun txt (text pt lay HEI / mytext)
    (OBJECT)
    (SETQ
      MYTEXT (VLA-ADDTEXT MP text (vlax-3d-point pt) HEI)
    )
    (vla-put-layer myTEXT lay)
    (vla-put-color myTEXT 101)
    (vlax-release-object mp);释放内存
  )
;;;*****************************
  (defun lwpl1 ()
    (SetQ pel (EntGet pen)                ;取出对象数据表
          pel (Member '(100 . "AcDbPolyline") pel) ;取出其中的有关数据
          pln (Cdr (Assoc 90 pel))        ;取出控制点数量
          ptp (Cdr (Assoc 70 pel))        ;取出结束片段类型
    )
    (SetQ pan 6                                ;数据读取序号初值
          wpl '()                        ;自建的点位数据表
    )
    (Repeat pln
      (SetQ plp        (Cdr (Nth pan pel))        ;取出控制点点位
            par        (Cdr (Nth (+ 3 pan) pel)) ;取出弓弦比
            wpl        (Cons (List plp par) wpl) ;将数据加到WPL表中
      )
      (SetQ pan (+ 4 pan))                ;序号步进
    )
    (SetQ wpl (Cons (Last wpl) wpl)        ;加入封闭点
          wpl (Reverse wpl)                ;整理WPL表
          pn  0
          rl  (Length wpl)
    )
    (SetQ clk (If (Or (= 0 ptp) (= 128 ptp))
                "开口"
                "封闭"
              )
    )                                        ;判断封闭与口
    (If        (= "开口" clk)
      (progn
        (SETQ HH (GETVAR "DIMTXT"))
        (SETQ COUNT 1)
        (SETQ LLENG 0)
        (setq p1 (getpoint (trans p0 0 1) "\n 请点取展开尺寸标示处..."))
        (if (null p1)
          (setq p1 p0)
          (setq p1 (trans p1 1 0))
        )
        (TXT "Entity" p1 "ZHAN" HH)
        (TXT "Type" (polar p1 0 (* hh 10)) "ZHAN" HH)
        (TXT "Radius" (polar p1 0 (* hh 20)) "ZHAN" HH)
        (TXT "Angle" (polar p1 0 (* hh 30)) "ZHAN" HH)
        (TXT "Length" (polar p1 0 (* hh 40)) "ZHAN" HH)
        (TXT "(Sub)Total" (polar p1 0 (* hh 50)) "ZHAN" HH)
        (setq p1 (polar p1 (* 1.5 pi) (+ 2 hh)))
        (TXT "长度单位MM,前生制作-13764852693@139.com" (polar p1 0 (* hh 30)) "ZHAN" HH)
        (setq p1 (polar p1 (* 1.5 pi) (+ 2 hh)))
      )
    )
    (If        (= "开口" clk)
      (Repeat
        (- rl 2)                        ;逐点分析
         (SetQ al (Nth pn wpl)                ;取出点数据表
               pt (Car al)                ;取出点位
         )
         (If (And (/= 0.0 (Cadr al)) (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)) ;半径算
                   leng         (* bj (Abs rr))
                   LLENG (+ LLENG LENG)
             )
             (SetQ cp (Polar pt (SetQ pa (Angle pt np)) xc) ;圆心点计算
                   cp (Polar cp (+ pa (* 0.5 Pi)) (- rr gg))
             )
             (ENTMAKE (list (cons 0 "CIRCLE")
                            (CONS 8 "ZHAN")
                            (cons 10 CP)
                            (CONS 40 (Abs rr))
                            (CONS 62 62)
                      )
             )
             (SETQ
               PP (GETPOINT (TRANS CP 0 1) "\n 请点取文本标示处<>:...")
             )
             (if (null pp)
               (setq pp cp)
               (setq pp (trans pp 1 0))
             )
             (ENTDEL (ENTLAST))
             (TXT (VL-PRIN1-TO-STRING COUNT) pP "ZHAN" HH)
             (TXT (VL-PRIN1-TO-STRING COUNT) p1 "ZHAN" HH)
             (TXT "ARC" (polar p1 0 (* hh 10)) "ZHAN" HH)
             (TXT (StrCat "R" (RToS (Abs rr)))
                  (polar p1 0 (* hh 20))
                  "ZHAN"
                  HH
             )
             (TXT (VL-PRIN1-TO-STRING (/ (* BJ 180.0) pi))
                  (polar p1 0 (* hh 30))
                  "ZHAN"
                  HH
             )
             (TXT (VL-PRIN1-TO-STRING LENG)
                  (polar p1 0 (* hh 40))
                  "ZHAN"
                  HH
             )
             (TXT (VL-PRIN1-TO-STRING LLENG)
                  (polar p1 0 (* hh 50))
                  "ZHAN"
                  HH
             )
             (setq p1 (polar p1 (* 1.5 pi) (+ 2 hh)))
           )
           (Progn
             (SetQ gx (Car al)                ;取出第一个点位置
                   np (Car (Nth (1+ pn) wpl)) ;取出下一点位
             )
             (ENTMAKE (list (cons 0 "LINE")
                            (CONS 8 "ZHAN")
                            (cons 10 gx)
                            (CONS 11 np)
                            (CONS 62 62)
                      )
             )
             (SETQ PPP (LIST (* 0.5 (+ (CAR GX) (CAR NP)))
                             (* 0.5 (+ (CADR GX) (CADR NP)))
                       )
             )
             (setq LENG (distance gx np))
             (SETQ LLENG (+ LLENG LENG))
             (SETQ PP (GETPOINT (TRANS PPP 0 1) "\n 请点取文本标示处<>:..."))
             (if (null pp)
               (setq pp gx)
               (setq pp (trans pp 1 0))
             )
             (ENTDEL (ENTLAST))
             (TXT (VL-PRIN1-TO-STRING COUNT) pP "ZHAN" HH)
             (TXT (VL-PRIN1-TO-STRING COUNT) p1 "ZHAN" HH)
             (TXT "Line" (polar p1 0 (* hh 10)) "ZHAN" HH)
             (TXT "_____" (polar p1 0 (* hh 20)) "ZHAN" HH)
             (TXT (VL-PRIN1-TO-STRING (/ (* (angle gx np) 180.0) pi))
                  (polar p1 0 (* hh 30))
                  "ZHAN"
                  HH
             )
             (TXT (VL-PRIN1-TO-STRING LENG)
                  (polar p1 0 (* hh 40))
                  "ZHAN"
                  HH
             )
             (TXT (VL-PRIN1-TO-STRING LLENG)
                  (polar p1 0 (* hh 50))
                  "ZHAN"
                  HH
             )
             (setq p1 (polar p1 (* 1.5 pi) (+ 2 hh)))
           )
         )
         (SetQ pn (1+ pn))                ;搜索序号进
         (SETQ COUNT (1+ COUNT))
      )
      (Alert (StrCat "结束段状态:\n"
                     clk
             )
      )
    )
  )
;;;*****************************
  (PrinC "\n这是对 LWPolyLine 进行数据分析的基本程序...")
  (Alert
    "所选中性层Pline请设定为1:1绘制,否则计算的结果是错误的。..."
  )
  (entmake (list (cons 0 "circle")
                 (cons 8 "ZHAN")
                 (cons 10 (LIST 0 0))
                 (cons 40 0.3)
                 (cons 62 1)
           )
  )
  (ENTDEL (ENTLAST))
  (setvar "clayer" "zhan")
  (setq enn nil)
  (prompt
    "\n 运行该程序前﹐请先设定好中性层线<为Pline线>后,再进行。 \n"
  )
  (setq ene (entsel "\n 请选择中性层线:________"))
  (if ene
    (progn (setq pen (car ene))
           (setq ename (cdr (assoc 0 (entget Pen))))
           (if (= (strcase ename) "LWPOLYLINE")
             (progn
               (setq p0 (cadr ene))
               (lwpl1)
             )
             (prompt "\n 所选实体非Pline,Program over.Please try!")
           )
    )
    (prompt "\n Program over.Please try!")
  )
  (prompt "------ c:AR1 ------")
  (PRINC)
)