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

xudongchu 发表于 2017-12-10 16:48:02

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

xudongchu 发表于 2017-12-10 16:49:36

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

水吉空 发表于 2017-12-11 17:44:54

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

前生发表于 2017-12-11 21:48:28

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

前生发表于 2017-12-11 22:00:42

很久以前的一个老程序。写的啰嗦，也懒的弄了
(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表
   pn0
   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)
)

页: [1]

明经CAD社区's Archiver

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