连续模设计相关技术及AutoCAD二次开发lisp

只看该作者 · 发表于 2006-1-23 22:19:36

;;;当我们设计好剪口后就该用它了，预设镶件壁厚为5.0mm,自动取整
;;;镶件外形生成 Command:WX
这个不是很好用

谢谢建议，最新版如下
;;;********************************************************************1
;;;鑲件外形生成 Command:WX
;;;2005-11-05    Chen Jian
;;;Version 1.2 Change  (entsel) to (ssget)
;;;2005-10-11    Chen Jian
;;;Version 1.1 add (C:GETBOX)
;;;2005-07-01    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:WX (/       pt1    pt2    pt3    pt4    Y1       Y2
      midY lineY newY1 newY2 X1       X2       midX
      lineX newX1 newX2 newpt1  newpt2  newpt3  newpt4
               i       MAXpt1  MAXpt2  MAXpt3  MAXpt4
      )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (command "undo" "be")
;;;取得新的最點,重載WX
  (setq ename-name nil)
  (setq des-GetBox-OK nil)
  (if (null DES-WX-T)
  (setq DES-WX-T (getreal "請輸入鑲件的大約壁厚[4/5/6/7/8/...]<5>: ")))
  (if (null DES-WX-T)
(setq DES-WX-T 5.0)
  )
  (if (null ss)
  (setq ss (ssget)))
  (if (/= ss nil)
(progn
   (setq i 0)
   (repeat (sslength ss)
(setq ename-name (ssname ss i))
(sub-GetBoundingBox ename-name)
;;; 更新最值
(if (= des-GetBox-OK 1)
   (progn
      (setq Y1 (cadr des-GetBox-top-pt1))
      (setq Y2 (cadr des-GetBox-bottom-pt2))
      (setq X1 (car des-GetBox-left-pt3))
      (setq X2 (car des-GetBox-right-pt4))

      (if (or (null MAXpt1) (> Y1 MAXpt1))
      (setq MAXpt1 Y1)
      )
      (if (or (null MAXpt2) (< Y2 MAXpt2))
      (setq MAXpt2 Y2)
      )
      (if (or (null MAXpt3) (< X1 MAXpt3))
      (setq MAXpt3 X1)
      )
      (if (or (null MAXpt4) (> X2 MAXpt4))
      (setq MAXpt4 X2)
      )
   )
)
(setq i (1+ i))
   )
   (setq Y1 MAXpt1)
   (setq Y2 MAXpt2)
   (setq X1 MAXpt3)
   (setq X2 MAXpt4)
   (if (= des-GetBox-OK 1)
(progn
   (setq midY (/ (+ Y1 Y2) 2.0)) ;中點Y座標
   (setq
      lineY (+ (/ (fix (abs (- Y1 Y2))) 2.0) (+ DES-WX-T 0.5))
   )
   (setq newY1 (+ midY lineY))
   (setq newY2 (- midY lineY))

   (setq midX (/ (+ X1 X2) 2.0)) ;中點X座標
   (setq
      lineX (+ (/ (fix (abs (- X2 X1))) 2.0) (+ DES-WX-T 0.5))
   )
   (setq newX1 (- midX lineX))
   (setq newX2 (+ midX lineX))

   (setq newpt1 (list newX1 newY1))
   (setq newpt2 (list newX2 newY1))
   (setq newpt3 (list newX2 newY2))
   (setq newpt4 (list newX1 newY2))
   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
   (setq oldcolor (getvar "CECOLOR"))
   (setvar "CECOLOR" "3")
   (command "PLINE" newpt1 newpt2 newpt3 newpt4 "c")
   (setvar "CECOLOR" oldcolor)
   (setvar "osmode" os)
   (setq ss nil)
   (setq DES-WX-T nil)
   (command "undo" "e")
)
(Princ "\n------操作失敗,可能是無法取得鑲件外形!")
   )
)
(Princ "\n------無對象?!")
  )
  (Princ "\n-----------Bye c:WX 鑲件外形生成------------")
  (prin1)
)

只看该作者 · 发表于 2006-1-23 23:04:52

我使用的设置，可能与大家不同,讲讲你们的

1. 图层管理(以连续模第一组板为例,依此类推)
a. 10-01层构成上模座盖板层,10-1为其标注层；
b. 09-01层构成上模座板层,09-1为其标注层;
c. 08-01层构成上垫板层,08-1为其标注层;
d. 07-01层构成公夹板层,07-1为其标注层;
e. 06-01层构成脱料背板层,06-1为其标注层;
f. 05-01层构成脱料板层,05-1为其标注层;
g. 01-01层构成下模板层,01-1为其标注层;
h. 02-01层构成下垫板层,02-1为其标注层;
i. 03-01层构成下模座板层,03-1为其标注层;
j. 04-01层构成垫脚层,04-1为其标注层;
k. D-B 　层构成导料板层;
l. 在”LAYOUT”层绘制产品图,排样图;
m. 在”0”层绘制零件图,组立图, 成形结构图。
2. 线色,线型设置
a. 带锥度线割采用红色(RED)线条,线宽设置为0.25;
b. 直身线割采用绿色(GREEN)线条,线宽设置为0.25;
c. 铰孔采用绿色(GREEN)线条,线宽设置为0.25;
d. 磨床加工采用白色(WHITE)线条,线宽设置为0.25;
e. 铣床加工采用白色(WHITE)或蓝色(BLUE)线条,线宽设置为0.25;
标注采用紫红色(MAGENTA)或白色(WHITE)线条,线宽设置为0.15。

[ 本帖最后由 chenjian1 于 2006-1-23 15:08 编辑 ]

只看该作者 · 发表于 2006-1-23 23:44:52

集中一下

;;;********************************************************************1
;十字光标角度调整 Command:AC
;;;Version 1.0
(defun c:AC (/ en ang entyp pt10 pt11)
  (setq en (entsel "\n选取线、文字或图块 <0>: "))
  (if en
(progn
   (setq endata (entget (car en)))
   (setq entyp (cdr (assoc 0 endata)))
   (cond ((= entyp "LINE") (line-ang))
         ((= entyp "TEXT") (text-ang))
         ((= entyp "INSERT") (text-ang))
         (t (2p-ang))
   )
)
(setq ang 0)
  )
  (setvar "snapang" ang)
  (princ
"\n---Bye c:Ac 光标角度调整!---"
  )
  (prin1)
)

(defun line-ang       ()
  (setq pt10 (cdr (assoc 10 endata)))
  (setq pt11 (cdr (assoc 11 endata)))
  (setq ang (angle pt10 pt11))
)

(defun text-ang       ()
  (setq ang (cdr (assoc 50 endata)))
)

(defun 2p-ang ()
  (setq ang (getangle "\n输入角度值: "))
)

只看该作者 · 发表于 2006-1-24 07:40:59

thanks

只看该作者 · 发表于 2006-1-24 20:53:38

这个指令应该还可以修该一下,只要点选一点即可

已修改
;;;********************************************************************1
;;;制做扣位沉頭 command c:GG
;;;2005-01-24    Chen Jian  Change to:use one point
;;;Version 1.1
;;;2004-05-18    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:GG (/ en midpt endpt1 endpt2 pt1 pt2 pt3 pt4 pt5 pt6)
  (setvar "cmdecho" 0)
  (setq en (entsel "\n選取要做扣位沉頭的直邊... "))
  (if en
(progn
   (setq endata (entget (car en)))
   (setq entyp (cdr (assoc 0 endata)))
   (cond ((= entyp "LINE") (sub-GG))
      ((= entyp "LWPOLYLINE") (sub-GG))
      (t (Princ "\n制做扣位沉頭失敗!"))
   )
)
(Princ "\n空操作!")
  )
  (prin1)
)

(defun sub-GG ()
  (setq midpt (osnap (cadr en) "mid"))
  (setq endpt1 (osnap midpt "end"))
  (setq endpt2 (polar endpt1
      (angle endpt1 midpt)
      (* (distance endpt1 midpt) 2.0)
         )
  )
  (setq pt1 endpt1
;;;    (getpoint "\nEnter first point:")
  )
  (setq pt2 endpt2
;;;    (getpoint "\nEnter second point:")
  )
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq pt3 (polar pt1 (+ (angle pt1 pt2) (* pi 0.5)) 2))
  (setq pt4 (polar pt2 (+ (angle pt1 pt2) (* pi 0.5)) 2))
  (setq pt5 (polar pt1 (- (angle pt1 pt2) (* pi 0.5)) 2))
  (setq pt6 (polar pt2 (- (angle pt1 pt2) (* pi 0.5)) 2))
  (command "pline" pt3 pt4 "a" pt6 "l" pt5 "a" "cl")
  (setvar "osmode" os)
  (Princ "\n-----------Bye c:GG 制做扣位沉頭------------")
)

只看该作者 · 发表于 2006-1-25 12:55:30

;;;********************************************************************1
;;;增強性偏移  (复线偏单边) Command:EO
;;;2006-01-25    Chen Jian
;;;Version 1.1
;;;2005-09-19    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:EO (/ lastdd dd en1 en1-data en1-type  pt1)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq lastdd (getvar "OFFSETDIST"))
  (if (= lastdd -1)
(setq lastdd 1)
  )
  (Princ "\n輸入偏移距離")
  (Princ "<")
  (Princ lastdd)
  (Princ ">:")
  (setq dd (getdist ""))
  (if (null dd)
(setq dd lastdd)
  )
  (setq en1 (entsel "\n選取欲偏移的直邊 <結束>:"))
  (while en1
;;;當en1存在時，做以下內容，直到en1不存在為止
(setq en1-data (entget (car en1)))
(setq en1-type (cdr (assoc 0 en1-data))) ;群碼0為對象類型
(setq pt1 (getpoint "\n指定要在那一側偏移複製的點: "))
;;; (setq dd (getdist "\n輸入偏移距離[1/1.5/2.5]<1>: "))
;;; (if (null dd)
;;;    (setq dd 1)
;;; )
;;; (if (= en1-type "LWPOLYLINE")
;;;    (sub-OFFSET-LWPOLYLINE en1)
;;;    (command "OFFSET" dd en1 pt1 "")
;;; )
(cond ((= en1-type "LINE") (command "OFFSET" dd en1 pt1 ""))
   ((= en1-type "LWPOLYLINE") (sub-OFFSET-LWPOLYLINE en1))
   (t (Princ "\n無法偏移複製該物件。"))
)
(setq en1 (entsel "\n選取欲偏移的直邊 <結束>:"))
  )
  (setvar "OFFSETDIST" dd)
  (command "undo" "e")
  (Princ "\n---------------Bye c:EO 增強性偏移---------------"
  )
  (prin1)
)

(defun sub-OFFSET-LWPOLYLINE (en)
  (setq midpt (osnap (cadr en) "mid"))
  (setq Linept1 (osnap midpt "end"))
  (setq Linept2 (polar Linept1
         (angle Linept1 midpt)
         (* (distance Linept1 midpt) 2.0)
)
  )

;;;  (setq Linept1 (getpoint "\npt1: "))
;;;  (setq Linept2 (getpoint "\npt2: "))
  (command "line" Linept1 Linept2 "")
  (setq en2 (entlast))
  (command "OFFSET" dd en2 pt1 "")
  (command "ERASE" en2 "")
;;;  (Princ "\nOFFSET-LWPOLYLINE ok")
)

[ 本帖最后由 chenjian1 于 2006-1-25 04:56 编辑 ]

只看该作者 · 发表于 2006-1-25 13:23:48

一套端子模 T=0.35，共48 pin,其中有部分pin 偏斜,（90度折弯高10mm左右），请问各位在实际中是如何调整的。
（冲头是钨钢，PG加工，入子钨钢线割，押板块0.003滑配，冲切间隙单边0.01,冲切多压料0.03，成形已加限位）
（有经验的请在后面告诉我一下）

[ 本帖最后由 chenjian1 于 2006-2-1 11:53 编辑 ]

只看该作者 · 发表于 2006-1-25 13:50:37

快速切换图层的程序
;;;********************************************************************1

;;;設置當前層

;;;2004-06-01 Chen Jian

;;;Version 1.0

;;;2005-09-02 Chen Jian

;;;Version 1.1

(DEFUN C:00(/ S)

  (setvar "cmdecho" 0)

  (setq s (getstring "圖層: "))

  (COMMAND "LAYER" "T" "*" "U" "*" "S" S "OFF" "*" "" "")

  (PRIN1)

  )

(DEFUN C:+(/ S)

  (setvar "cmdecho" 0)

  (setq s (getstring "圖層: "))

  (COMMAND "LAYER" "ON" s "")

  (PRIN1)

  )

(DEFUN C:-(/ S)

  (setvar "cmdecho" 0)

  (setq s (getstring "圖層: "))

  (COMMAND "LAYER" "OFF" s "")

  (PRIN1)

  )

(DEFUN C:+9 ()

  (setvar "cmdecho" 0)

  (COMMAND "LAYER" "T" "*" "U" "*" "ON" "09-01" "")

  (Princ "\打開了上模座")

  (PRIN1)

)

只看该作者 · 发表于 2006-1-25 13:54:09

爆搞笑

绝对让你笑破肚皮!爆搞笑的短信
1.老夫妇去拍照，摄影师问:“大爷，您是要侧光，逆光，还是全光?"，大爷腼腆的说:“我是无所谓，能不能给你大妈留条裤衩?"
　　2.老婆语录:允许你喝醉，允许你勾妹，但晚上必须给老娘归队，如果你敢伤我的心，伤我的肺，老娘一定把你的第三条腿打残废，让你的鸟鸟永远打嗑睡。
　　3.两个饺子结婚了，送走客人后新郎回到卧室，竟发现床上躺着一个肉丸子!新郎大惊，忙问新娘在哪?肉丸子害羞的说:讨厌，人家脱了衣服你就不认识啦!
　　4.俩老夫妻某日吃晚饭时突发奇想:裸餐!找找从前的感觉!脱光后老太婆道:我还有反应耶!乳房还和年轻时一样发热!老头斜了一眼道:耷拉到汤里了!
　　5.四只老鼠吹牛:甲:我每天都拿鼠药当糖吃;乙:我一天不踩老鼠夹脚发痒;丙:我每天不过几次大街不踏实;丁:时间不早了，回家抱猫去咯。
　　6.天是蓝的，海是深的，男人的话没一句是真的;爱是永恒的，血是鲜红的，男人不打是不行的;男人如果是有钱的，和谁都是有缘的，男人靠的住，猪都会爬树。
　　7.一群蚂蚁爬上了大象的背，但被摇了下来，只有一只蚂蚁死死地抱着大象的脖子不放，下面的蚂蚁大叫:掐死他，掐死他，小样，还他妈反了!
　　8.小孩把妓院养的鹦鹉偷回家，一进门，鹦鹉便叫:搬家啦!看见他妈妈又叫:老板也换啦!看见他姐姐又叫:小姐也换了!看见他爸爸又叫:我cao还是老客!
　　9.漫漫人生路，谁不错几步!家庭要照顾，情人也得处!家里有个做饭的，外面养个心善的，对桌坐个好看的，远方有个思念的!保住二，守住一，发展三四五六七!
　　10.一只小狗爬上你的餐桌，向一只烧鸡爬去，你大怒道:你敢对那只烧鸡怎样，我就敢对你怎样，结果小狗舔了一下鸡屁股，你昏倒，小狗乐道:小样看谁狠。
11.传说今晚，阴魂不散，死光又现，鬼魂四处转!愿鬼听到我的呼唤，半夜来到你庆头，苍白的脸，幽绿的眼，干枯的手抚摸你的脸，代我向你说一句:晚安!
　　12.男人，总是笑容满面，两眼放电，不是发病犯贱，就是坑蒙拐骗!女人丰胸细腰，放荡风骚，不是掏你腰包，就是放你黑刀!这年月男怪女妖，小心中招啊!
　　13.你走在路上，一母狗扑向你从你的脚上咬了一块肉，迅速吞下去，你伸脚正要踢它的时候，狗含着泪说:你打吧，反正我肚里已经有了你的骨肉!
　　14.老鼠没女朋友特别郁闷，终于一只蝙蝠答应嫁给他，老鼠十分高兴。别人笑他没眼光，老鼠:你们懂什么，她好歹是个空姐。
　　15.朋友问蝙蝠怎么会下嫁给老鼠，蝙蝠眼含泪花，意味深长:唉!那天他吃了伟哥，火力壮，一下蹦上天花板，让他得了手。
　　16.我花一毛钱发这条短信给你，是为了告诉你——我并不是一个一毛不拔的人。比如这一毛钱的短信就是我送你的生日礼物。
　　17.蚂蚁懒洋洋地躺在土里，伸出一只腿，朋友问你干嘛呢?蚂蚁:待会大象来了，绊他一跟头。
　　18.喜鹊来，妈妈说这是喜鸟是客;燕子来，妈妈说这是益鸟是客;乌鸦来，孩子问你也是客人吗?乌鸦叫:Yes，吾乃黑客!
　　19.某美女发现口红太重，拿湿纸巾擦拭后扔到路上。一老头拣起，端详半天突然醒悟，追上说:姑娘，这超薄的就是容易掉呀!
　　20.黄瓜失恋痛哭，茄子安慰她:爱情不单只是甜美、只是沉醉，还有心碎、还有流泪。唉!谁让你爱上洋葱的?
21.太监最讨厌的歌:把根留住;太监最讨厌的剧本:一剪梅;太监最讨厌的广告词:我有我可以;太监最讨厌的成语:空前绝后;太监最喜欢做的事:边看短信边笑。
　　22.记得你我小时候两小无猜青梅竹马，我喜欢唱歌你喜欢跳舞，我能唱二百首歌你就会跳二百支舞，所以大家见到我都叫我二百哥，见到你就叫二百舞。
　　23.当你在路上遇到狗的时候不要惊慌，要勇敢地与它博斗，仅多会有三种结果:一是你赢了，你比禽兽还禽兽;二是你输了，你连禽兽都不如;三是你们打平了，你就是禽兽。 !
　　24.“为什么你要夹一支温度计在耳朵上?”实习医生问老医生.老医生:“完了!我一定把钢笔插在病人的肛门里了!”
　　25.有一个山里人，没见过世面，一天到城市的公园里看见一个人在做俯卧撑，不知道干什么的，围着转了好几圈都不明白:为什么底下没人，光使劲?
　　26.在一次男女同学聚会喝酒时,有的女同学不会喝酒就喝奶, 在敬酒时,男同学对喝奶的女同学说:我们换着喝好吗，你们喝我们的酒，我们喝你们的奶。
　　27.一小学生对已暗恋许久的老师表白.老师说这样不对,可他不听.最后老师受不了了,说:“我不要小孩子啦!”小学生说:“老师,我一定会很小心的?”
　　28.最近你很坏，总想捞外快。老婆你不爱，天天找姨太。虽然你很帅，却是残花败。床下慷而慨，床上很无奈。
　　29.男女朋友睡一个房间，女的画了条线说:“过线的是禽兽。”醒来发现男的真的没过线，女的狠狠的打了男的一巴掌:“你连禽兽都不如。”
　　30.次日男女有同睡一房女的照旧画了条线警告，男的有了上次的教训深夜打算过线，结果因为紧张而未果。天亮后，女的有打男的一巴掌说:“没想到你不如禽兽。”
31.在医院里，一家喜得贵子，孩子刚生下来就回说话，孩子说:“爷爷。”爷爷啊的一声就死了。孩子又说:“奶奶。”奶奶啊的一声死了。孩子又说:“爸爸。”他爸爸啊的一声，一看自己没死，这个时候，孩子的老叔啊的一声死了。
　　32.袋鼠和青蛙去嫖鸡，袋鼠三下两下完事，只听隔壁的青蛙整夜一二三嘿!一二三嘿!袋sd鼠好羡慕，次日，袋鼠说:“哇!~~蛙兄，你好棒哦!。”青蛙说:“cao，老子一夜都没跳上床!~~”
　　33.我那天在超市看见一个看帖不回帖的人，他悄悄D把手放在条码扫描器上，只见屏幕显示:猪蹄 8元，他以为机器坏了，把脸凑过去，结果屏幕上显示:猪头肉 5元
　　34.一只大象问骆驼:‘你的咪咪怎么长在背上?’骆驼说:‘死远点，我不和鸡鸡长在脸上的东西讲话!
　　35.小女孩总是向小男孩炫耀自己的新玩具.小男孩没办法,只好脱掉裤子说:这个你永远没有!女孩也脱掉裤子说:我妈说只要有这个,你那玩意儿要多少有多少!
　　36.小蚊子哭着回家，妈妈问咋了?小蚊子:爸爸死啦!蚊妈妈:他没有带你去看演出?小蚊子:看了，可观众一鼓掌，爸爸没有躲开。。。。。
　　37.蚂蚁和大象结婚了，可是没几天大象就死了，蚂蚁非常伤心，一边哭一边骂到:亲爱的，你怎么走在我前面了呢，这辈子我他妈不用干别的了，就埋你了!!!
　　38.哥几个去饭店，回家钞票笑:我给老板两张假钞，白吃;发票乐:多开一百块，赚了;支票哭:收银小姐多添个0，亏大了。
　　39.认识你这么久，你在我心目中的位置，其实你应该很清楚。除了你之外，其他人在我眼只只不过是一堆屎，可你不一样，因为你是.........两堆!
　　40.你又在工作吧!我不止一次对你说不要这样玩命的工作，要注意身体，可你总是意味儿深长地说:不趁天暖多滚几个粪球，冬天我吃什么?

41.昨天梦见上帝说可满足我一个愿望我拿出地球仪说要世界和平，他说太难换一个吧，我拿出你的照片说要这人变漂亮，他沉思了一下说拿地球仪我再看看。
　　42.一女奇丑，嫁不出去，希望被拐卖。终于梦想成真，却半月卖不出去。绑匪将其送回，她坚决不下车，绑匪咬牙一跺脚:走，车不要了
　　43.20年前爸爸抱着你等车，人都笑话孩子长得难看，爸爸哭了。一卖香蕉的老大爷拍拍爸爸说:“大兄弟别哭了，拿只香蕉给猴子吃吧!真可怜，饿的都没毛了。”
　　44.飞机上，一只鹦鹉对空姐说:“给爷来杯水”，猪也学鹦鹉，对空姐说:“给爷来杯水”，空姐大怒，将鹦鹉和猪都扔下了飞机。这时鹦鹉对猪说:“傻 B 了吧，爷会飞。”
　　45.有个老农在地里锄地，一只乌鸦飞过，拉了泡屎掉在老农脸上，老农抬头大骂:“CAO 你妈!出门也不知道穿条裤衩!” 乌鸦说: “CAO!你丫拉屎穿裤衩呀!”v
　　46.小明告诉妈妈，今天客人来家里玩的时候，哥哥放了一颗图钉在客人的椅子上，被我看到了。妈妈说:“那你是怎幺做的呢?” 小明说:“我在一旁站着，等客人刚要坐下来的时候，我将椅子从他后面拿走了。”
　　47.一天在拥挤的公车上的一段对话情形如下:一个站着的怀孕妇人对着他身旁坐着的一位男子说:『你不知道我怀孕了吗? 』(想要他让座.... ) 只见男子很紧张的说:『孩子不是我的!』
　　48.仅仅是一阵风也罢了，偏偏是这样永恒，仅仅是一场梦也罢了，偏偏是如此真实，你低头不语，我却难以平静，我终于禁不住要对你说，:下次放屁时，说一声!
　　49.一对恋人在山中被野人抓住说:你们吃掉对方的大便就放了你们。恋人做到了，归途中女人大哭，男人问其原因，女人伤心的说:你不爱我，不然你不会拉那么多!

只看该作者 · 发表于 2006-1-31 20:17:58

翻孔设计标准,供参考用

连续模设计相关技术及AutoCAD二次开发lisp

我使用的设置，可能与大家不同,讲讲你们的

增強性偏移 (复线偏单边)

翻孔设计标准

本帖子中包含更多资源