iCAx开思网

标题: 连续模设计相关技术及AutoCAD二次开发lisp [打印本页]

作者: chenjian1 时间: 2006-1-20 22:35
标题: 连续模设计相关技术及AutoCAD二次开发lisp
主题：连续模设计相关技术及AutoCAD二次开发lisp

关于：品质  交期  成本
         技术  软件

内容有：连续模相关技术
            自己设计的连续模设计专用软件，lisp源程序，大家可以pp,我可以改改

目的：大家一起做个轻松快乐的设计师
         挤点时间享受生活哈

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

作者: chenjian1 时间: 2006-1-20 22:39
标题: 1-将选取的图形拷贝到指定的图层
;;;********************************************************************1
;;;将选取的图形拷贝到指定的图层 Command:k
;;;2004-01-08    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:K(/ en2 en3 yesno)
  (setvar "cmdecho" 0)
  (princ "请选取欲拷贝的图形:")
  (setq en2 (ssget))          ;选取欲拷贝的图形
  (if (= en2 nil)
(sub-quit)
(sub-kkk en3 chklay YESNO)
)
  )

(defun sub-kk()
  (command "copy" en2 ""  "0,0" "")
  (command "change" en2 "" "p" "la" en3 "")
  (princ "\n所选图已拷贝到图层")
  (prin1 en3)
  (prin1))

(defun sub-kkk (en3 chklay yesno)
  (setq en3 (getstring "请输入图层名:"))
  (if (= en3 "")
(progn (sub-quit))
(progn (setq chklay (tblsearch "layer" en3))
         (if (= chklay nil)
         (progn(setq yesno(getstring "\n层不存在，是否建立<N>:"))
                  (if       (or (= yesno "Y") (= yesno "y"))
                  (progn
                     (command "layer" "n" en3 "")
                     (sub-kk)
                  )
                  (progn (sub-quit))
                  )
         )
         (progn (sub-kk))
         )
)
  )
)
有问题请E-mail:ChenJianCaiHong@163.com

作者: administrtor 时间: 2006-1-21 12:36
标题: 有个了用
这个lsp不好用啊。兄弟

作者: chenjian1 时间: 2006-1-21 23:58
请说明哪里不好用，谢谢。
其实这个程序可以演变成快速开孔的程序，即在每块模板里生成孔...

作者: chenjian1 时间: 2006-1-22 00:11
DES0001NAME:ChenJian
DES:ChenJian
E-mail:ChenJianCaiHong@163.com
2005-10-18
Die-Des-Pass.lic
1. 本「Die-Des五金連續模設計 FOR AutoCAD」軟件,以下簡稱「Die-Des」或「軟件」已採取技術性措施，以防止其遭盜用。
2. 不要改動此文件,否則[Die-Des]軟件將變得不可使用!
3. 升級版。若要使用註明為升級版之「軟件」，貴用戶必須先取得註明為可合法升級之軟件的授權,此為客戶編號。
4. 禁止轉售此軟件。不得轉售或以其他方式作有對價之轉讓，亦不得用於示範、測試或評估以外之其他用途。
5. 此「軟件」係以單一產品方式授權使用，其組件不得分開提供給多部裝置使用。
6. 使用此「軟件」的目的是提高五金連續模設計效率,減少人為的錯誤,使用或不使用此「軟件」給你帶來的任何有形或無形的損失,本人不負任何責任。
7. 如果你一但安裝或使用本軟件,即表明你已接受以上申明,否則請不要安裝或使用本軟件。
8. 安裝:請先將本軟件文件夾放入你硬盤的<D:>盤,在AutoCAD中設置支持路徑，然后將本軟件拖入AutoCAD的繪圖區后即可使用,為了方便,請根據命令行提示加載菜單。
9. 若有問題請發郵件給E-mail:ChenJianCaiHong@163.com。
10.第一行為客戶編號。

以后我会发表一部分lisp源程序，希望大家多讨论软件的算法。
目的：做一个轻松快乐的设计师。

作者: chenjian1 时间: 2006-1-22 00:28
标题: 时间显示有问题
请管理员注意，我发的贴时间显示有问题

作者: chenjian1 时间: 2006-1-22 00:33
标题: 內六角螺絲參數-软件
內六角螺絲參數-软件

作者: chenjian1 时间: 2006-1-22 00:36
标题: 级进模专业英语-软件
仅供参考

作者: chenjian1 时间: 2006-1-22 12:56
呜，俺的软件哪去了

奥，看到了

[ 本帖最后由 chenjian1 于 2006-1-22 10:52 编辑 ]

作者: chenjian1 时间: 2006-1-22 18:50
标题: 衝壓模具技術魚骨圖
看看自己少啥哈哈

作者: chenjian1 时间: 2006-1-22 19:07
标题: 菜單檔
希望大家提出自己比较关心的功能好集中讨论
//
//    AUTOCAD 菜單檔 - D:\DIE-DES\menu\des.mnu
//    V1.4  2005-12-07  CHENJIAN
//    V1.3  2005-11-25  CHENJIAN
//    V1.2  2005-10-07  CHENJIAN
//    V1.1  2005-08    CHENJIAN 請不要修改!
//***MENUGROUP=輔助設計
***MENUGROUP=DESMENU

***POP15
ID_MyDES    [連續模設計(&A)]
ID_MyK    [拷貝到...(&K)]^C^C_K
ID_MyAC    [捕捉角度調整(&A)]^C^C_AC
ID_MySetGAP  [設置過孔間隙(&B)]^C^C_SETHOLEGAP
            [--]
ID_MySetall  [總體設定(&S)]^C^C_SETALL
ID_MyZK    [展開計算(&Z)]^C^C_ZK
ID_MyZKL    [展開縣繪製(&D)]^C^C_ZKL
ID_MyLAYOUT  [排樣參考(&E)]^C^C_VIEWREFLAYOUT
ID_MyUSERX [利用率計算(&U)]^C^C_USERx
            [--]
ID_Mylay    [建立圖層(&G)]^C^C_READLAY
ID_MyAUTOPLN [->模板外形生成(&H)]
ID_MyAUTOPLN1 [第一組(&A)]^C^C_PLANT1
ID_MyAUTOPLN2 [<-第二組(&B)]^C^C_PLANT2
ID_MyAUTOWX  [鑲件外形生成(&I)]^C^C_WX
            [--]
ID_MyCUTM [->依板制做剪口孔(&L)]
ID_MyCUT1 [制做剪口01-01<可偏移>(&A)]^C^C_CUT1
ID_MyCUT2 [制做剪口01-02<可偏移>(&B)]^C^C_CUT2
ID_MyXCUT1 [制做剪口01-01<不可偏移>(&C)]^C^C_XCUT1
ID_MyXCUT2 [制做剪口01-02<不可偏移>(&D)]^C^C_XCUT2
ID_MyXCUT [<-切邊剪口<0層>(&E)]^C^C_CUTSIDE
ID_MyPGwx [PG沖頭外形(&M)]^C^C_PGwx
ID_MySShape  [->成形孔佈置(&N)]
ID_MyShapeU1 [向下成形>07-05-1上模(&A)]^C^C_ShapeU1
ID_MyShapeU2 [<-向下成形>07-05-2上模(&B)]^C^C_ShapeU2
            [--]
ID_Mybend90  [90度折彎(&X)]^C^C_90
            [--]
ID_MyQJ    [快速串接(&J)]^C^C_J
ID_MyDESEO [復縣偏單邊(&O)]^C^C_EO
ID_MyPUNCHKW [沖頭加扣位(&P)]^C^C_KW
ID_Mygg    [掛勾(扣位)沉頭(&Q)]^C^C_GG
ID_MyQx    [端點處垂線toPG(&R)]^C^C_QX
ID_MyAutocs  [統計圓數量(&C)]^C^C_CS
ID_Mycam    [鑽孔程式生成(&T)]^C^C_CAM
ID_MyGo    [運動模擬(&F)]^C^C_GO
            [--]
ID_MyEE    [->專家系統(&V)]
ID_MyEE01 [內六角螺絲參數(&A)]^C^C_EE01
ID_MyEE02 [翻孔設計標準(&B)]^C^C_EE02
ID_MyEE03 [專業英語(&C)]^C^C_EE03
ID_MyEE04 [衝壓模具技術魚骨圖(&D)]^C^C_EE04
ID_MyEE05 [衝壓模具設計檢查表(&E)]^C^C_EE05
ID_MyEE06 [<-參考資料1(&F)]^C^C_EE06
***POP14
ID_accessory [組件(&B)]
ID_MyLock [->螺絲(&A)]
ID_MyDM4    [D-BM4(&A)]^C^C_D-BM4
ID_MyDM5    [D-BM5(&B)]^C^C_D-BM5
ID_MyL0    [01-M4(&C)]^C^C_01-M4
ID_MyL1    [01→03M8(&D)]^C^C_01-03M8
ID_MyL2    [02→01M5(&E)]^C^C_02-01M5
ID_MyL3    [06→05M5(&F)]^C^C_06-05M5
ID_MyL4    [06→05M6(&G)]^C^C_06-05M6
ID_MyL5    [07→M5(&H)]^C^C_07-M5
ID_MyL6    [08→07M5(&J)]^C^C_08-07M5
ID_MyL7    [09→07M8(&K)]^C^C_09-07M8
ID_MyL8    [09→05M6(&L)]^C^C_09-05M6
ID_MyL9    [<-09→05M8(&M)]^C^C_09-05M8
ID_MyPin    [->定位銷(&B)]
ID_MyD1    [D-BC4(&A)]^C^C_D-BC4
ID_MyD2    [D-BC5(&B)]^C^C_D-BC5
ID_MyP1    [01→03φ8(&C)]^C^C_01-03D8
ID_MyP2    [01→03φ10(&D)]^C^C_01-03D10
ID_MyP3    [06→05φ5(&E)]^C^C_06-05D5
ID_MyP4    [09→07φ8(&F)]^C^C_09-07D8
ID_MyP5    [<-09→07φ10(&G)]^C^C_09-07D10
ID_MyPost [->導柱(&C)]
ID_MyPost13  [輔助導柱SGPHφ13(&A)]^C^C_09-01C13
ID_MyPost16  [輔助導柱SGPNφ16(&B)]^C^C_09-01C16
            [--]
ID_MyPost25  [主導柱TRP25(&C)]^C^C_09-03C25GMS
ID_MyPost28  [主導柱TRP28(&D)]^C^C_09-03C28GMS
ID_MyPost32  [主導柱TRP32(&E)]^C^C_09-03C32GMS
ID_MyPost38  [主導柱TRP38(&F)]^C^C_09-03C38GMS
ID_MyPost45  [主導柱TRP45(&G)]^C^C_09-03C45GMS
ID_MyPost50  [<-主導柱TRP50(&H)]^C^C_09-03C50GMS
            [--]
ID_MyGuideP  [導料板(&D)]^C^C_GUIDEPLATE
ID_MyGLP    [->導位升降杆(&E)]
ID_MyGLP6 [φ6(&A)]^C^C_03-05GLP6
ID_MyGLP8 [φ8(&B)]^C^C_03-05GLP8
ID_MyGLP10 [φ10(&C)]^C^C_03-05GLP10
ID_MyGLB8 [<-GLB8(&D)]^C^C_03-05GLB8
ID_MyLIF    [->頂出銷(&F)]
ID_MyLIF3 [φ3(&A)]^C^C_03-LIFTER-M5-C3
ID_MyLIF4 [φ4(&B)]^C^C_03-LIFTER-M8-C4
ID_MyLIF6 [φ6(&C)]^C^C_03-LIFTER-M10-C6
ID_MyLIF8 [φ8(&D)]^C^C_03-LIFTER-M12-C8
ID_MyLIF10 [<-φ10(&E)]^C^C_03-LIFTER-M16-C10
ID_MyLIF10 [誤送檢知器(&G)]^C^C_CHKPIN
ID_MyLIF12 [下死點檢知器(&H)]^C^C_CHKDOWN
            [--]
ID_MyFK    [->浮塊(&J)]
ID_MyFKM3 [鎖浮塊M3(&A)]^C^C_03-FK-M3
ID_MyFKFM5 [鎖浮塊M5(&B)]^C^C_03-FK-M5
            [--]
ID_MyJK    [<-鎖夾塊M4(&C)]^C^C_JK-02-M4
            [--]
//ID_MyHole  [->標準孔(&K)]
ID_MyHole01  [->導針孔(&K)]
ID_MyHole03  [1.2 (&A)]^C^C_P1D2
ID_MyHole05  [1.5 (&B)]^C^C_P1D5
ID_MyHole07  [2.0 (&C)]^C^C_P2D0
ID_MyHole09  [2.5 (&D)]^C^C_P2D5
ID_MyHole11  [3.0 (&E)]^C^C_P3D0
ID_MyHole13  [<-5.0 (&F)]^C^C_P5D0
ID_MyHole15  [->吹氣銷孔(&L)]
ID_MyHole17  [吹氣銷φ4(&A)]^C^C_AIR-C4
ID_MyHole19  [<-吹氣銷φ5(&B)]^C^C_AIR-C5
ID_MyHole21  [敲擊孔(&M)]^C^C_QJK
ID_MyHole23  [->作動銷(&N)]
ID_MyHole25  [φ2(&A)]^C^C_COUNPIN2
ID_MyHole27  [φ3(&B)]^C^C_COUNPIN3
ID_MyHole29  [<-φ5(&C)]^C^C_COUNPIN5
ID_MyHole31  [->擊落銷(&P)]
ID_MyHole33  [φ1.5(&A)]^C^C_EJH1D5
ID_MyHole35  [φ2.0(&B)]^C^C_EJH2
ID_MyHole37  [<-φ3.0(&C)]^C^C_EJH3
ID_MyHole39  [->穿線孔(&Q)]^C^C
ID_MyHole41  [圖塊穿線孔φ2.1(&A)]^C^C_WH
ID_MyHole43  [虛中點穿線孔φ2.1(&B)]^C^C_ZDD
ID_MyHole45  [虛中點穿線孔φ1.1(&C)]^C^C_ZDX
ID_MyHole47  [<-智能中點穿線孔φ2.1(&D)]^C^C_AWH
            [--]
ID_MyFixPart [標件位置圓整(&R)]^C^C_FixPart
            [--]
ID_MyPlate [->標準模板(&S)]
ID_MyPlate01 [100x100(&A)]^C^C_100x100
ID_MyPlate02 [120x100(&B)]^C^C_120x100
ID_MyPlate03 [120x120(&C)]^C^C_120x120
ID_MyPlate04 [150x120(&D)]^C^C_150x120
ID_MyPlate05 [150x150(&E)]^C^C_150x150
ID_MyPlate21 [180x120(&F)]^C^C_180x120
ID_MyPlate06 [180x150(&G)]^C^C_180x150
ID_MyPlate07 [200x150(&H)]^C^C_200x150
ID_MyPlate08 [220x150(&I)]^C^C_220x150
ID_MyPlate09 [250x150(&J)]^C^C_250x150
ID_MyPlate10 [280x150(&K)]^C^C_280x150
ID_MyPlate11 [300x150(&L)]^C^C_300x150
ID_MyPlate12 [320x150(&M)]^C^C_320x150
ID_MyPlate13 [350x150(&N)]^C^C_350x150
ID_MyPlate14 [350x250(&O)]^C^C_350x250
ID_MyPlate15 [380x150(&P)]^C^C_380x150
ID_MyPlate16 [400x150(&Q)]^C^C_400x150
ID_MyPlate17 [420x150(&R)]^C^C_420x150
ID_MyPlate18 [450x150(&S)]^C^C_450x150
ID_MyPlate22 [450x180(&T)]^C^C_450x180
ID_MyPlate19 [450x250(&U)]^C^C_450x150
ID_MyPlate20 [<-480x150(&V)]^C^C_480x150
***POP13
ID_MyPart [輔助(&C)]
ID_Myword    [常用語(&E)]^C^C_WORD
ID_UcsOrigin1 [設置新原點(&U)]^C^C_UCS _N
ID_UcsOrigin  [*智能設置新原點(&N)]^C^C_AUTOSETUCS
ID_PLATERPT [*取得當前模板大小]^C^C_GetPlateRightPt
ID_Myad3ptX [*指定孔表放置點.橫排]^C^C_SETAD3PTX
ID_Myad3ptY [*指定孔表放置點.豎排]^C^C_SETAD3PTY
ID_MyAUTODIM  [->模板自動標注(&D)]
ID_MyAUTODIM1 [座標標注1(&A)]^C^C_AD
ID_MyAUTODIM3 [座標對齊標注2(&B)]^C^C_AD1
ID_MyAUTODIM5 [模板旁注1(&C)]^C^C_AD2
ID_MyAUTODIM7 [模板自動旁注2(&D)]^C^C_AD3
ID_MyAUTODIM9 [標注牙孔(&E)]^C^C_DM
ID_MyAUTODIM11 [<-標注沉頭孔(&F)]^C^C_DCT
ID_MyORDER [->模板加工說明(&O)]
ID_MyOutL01 [引線說明(&C)]^C^C_CSS
ID_MyORDER13  [用于φ13導柱(&A)]^C^C_ORDER13
ID_MyORDER16  [<-用于φ16導柱(&B)]^C^C_ORDER16
            [--]
ID_Myassdie  [組立圖(&Y)]^C^C_3DDIE
ID_MyBOM    [BOM(&B)]^C^C_BOM
ID_MyINSTK [插入圖框(&G)]^C^C_INSERTTK
            [--]
ID_MyPart02  [->圓沖(&C)]
ID_MyPart04  [φ4x1.52(&A)]^C^C_4D152
ID_MyPart06  [φ4x2.02(&B)]^C^C_4D202
ID_MyPart08  [φ5x1.52(&C)]^C^C_5D152
ID_MyPart10  [φ5x2.02(&D)]^C^C_5D202
ID_MyPart12  [<-φ5x3.02(&E)]^C^C_5D302
ID_MyPart16  [->小浮塊(&F)]
ID_MyPart18  [小浮塊M4(&A)]^C^C_XFKM4
ID_MyPart20  [<-小浮塊M5(&B)]^C^C_XFKM5
            [--]
ID_MyPart36  [側視圖生成(&T)]^C^C_TT
ID_Mypartno1  [零件序號]^C^C_PARTNO1
ID_Mypartno2  [零件編號(&X)]^C^C_PARTNO2
ID_Myda    [標尺寸序號(&H)]^C^C_DA
ID_Myaltext  [文字編號對齊(&A)]^C^C_ALTEXT
ID_MyFJ    [平鋪模板(&P)]^C^C_FJ
            [--]
ID_MyPart00 [材料說明(&M)]^C^C_ORDERMATL
ID_MyPart14  [沖頭加工說明(&7)]^C^C_ORDERPUNCH
ID_MyPart24  [押板塊加工說明(&5)]^C^C_ORDERSTR
ID_MyPart30  [入子加工說明(&1)]^C^C_ORDERINS
ID_MyORDERTC [縣割加工說明(&W)]^C^C_ORDERTC
ID_Myzzc    [算周長面積forTC(&I)]^C^C_ZZC
ID_MyEditMenu [編輯菜單文件]^C^C_EDITMENU
ID_MyLOADMenu [重新加載/更新菜單(&L)]^C^C_MENULOADD
ID_MyAbout [關於本軟件]^C^C_ABOUTDIEDES
***POP501
**CMDEFAULT
            [預設模式的上下文功能表]
ID_CMNonLast [重複%s(&R)]^C^C;
            [--]
ID_UcsOrigin1  [設置新原點]^C^C_UCS _N
ID_UcsOrigin [*智能新原點(&A)]^C^C_AUTOSETUCS
ID_PLATERPT [*取得當前模板大小]^C^C_GetPlateRightPt
ID_Myad3ptX [*指定孔表放置點.橫排]^C^C_SETAD3PTX
ID_Myad3ptY [*指定孔表放置點.豎排]^C^C_SETAD3PTY
ID_MyAUTODIM3  [模板自動旁注(&C)]^C^C_AD3
ID_MyAUTODIM4  [標注牙孔(&D)]^C^C_DM
ID_MyAUTODIM5  [標注沉頭孔(&E)]^C^C_DCT
            [--]
//ID_Cutclip    [剪下(&T)]^C^C_cutclip
//ID_Copyclip [複製(&C)]^C^C_copyclip
//ID_Copybase [以基準點複製(&B)]^C^C_copybase
//ID_Pasteclip [貼上(&P)]^C^C_pasteclip
//ID_Pastebloc [貼上為圖塊(&K)]^C^C_pasteblock
//ID_Pasteorig [貼到原始座標(&D)]^C^C_pasteorig
//             [--]
[3D環轉]'_3dorbit
ID_Filter    [快速選取(&Q)...]^C^C_qselect
ID_TextFind [尋找(&F)...]^C^C_find
ID_Preferenc [環境選項(&O)...]^C^C_options

***HELPSTRINGS
。。。。。。

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

作者: chenjian1 时间: 2006-1-22 19:22
1.1.1 (JIS G 3141) 冷輾壓低碳鋼板料及片料
Cold rolled carbon steel sheets and strips
1. 品質分類
品質標記功能類別制造用途
SPCC 一般應用品質文具用品,門鎖,汽車用品,電器支架,家具配件,一般雜項等.
SPCD 壓延、成形用品質電腦機箱,錄影機殼,,音響喇巴,電器箱,托盤,銀碟……等.
SPCE 深壓延拉伸品質電芯殼,手電筒,摩打殼,通心雞眼,鈕扣,油壼容器……等.
備注：
1. 標準回火處理的SPCC品質經采購者要求證明它可達到某拉力測試數值會在標記後加上’T’成為SPCCT.
2. 標準回火及退火處理的SPCE品質經采購者要求證明它具有無時放作用會在標記後加上’N’成為SPCEN.

2. 相對其他國家的對照
國家規格標記
JIS SPCC SPCD SPCE
ASTM A109M-91A366/A366M-91 A619/A619M-92 A620/A620M-91
BS EN10130:91 EN10131:92 --------
DIN 1624-87EN10130:91 EN10131:92 --------
ISO -------- -------- --------

3. 化學成份
品質標記碳  C 錳  Mn 磷  P 硫  S
SPCC 0.12 最大 0.50  最大 0.040  最大 0.045  最大
SPCD 0.10 最大 0.45  最大 0.035  最大 0.035  最大
SPCE 0.08 最大 0.40  最大 0.030  最大 0.030  最大
      4. 片材厚度公差(級別B)          單位:mm
寬度厚度(t) 160以下 160或以下至不包括250 250或以上至不包括400 400或以上至不包括630
t<0.10 ±0.010 ±0.020 ------ ------
0.10≦t<0.16 ±0.015 ±0.020 ------ ------
0.16≦t<0.25 ±0.020 ±0.025 ±0.030 ±0.030
0.25≦t<0.40 ±0.025 ±0.030 ±0.035 ±0.035
0.40≦t<0.60 ±0.035 ±0.040 ±0.040 ±0.040
0.60≦t<0.80 ±0.040 ±0.045 ±0.045 ±0.045
0.80≦t<1.00 ±0.04 ±0.05 ±0.05 ±0.05
1.00≦t<1.25 ±0.05 ±0.05 ±0.05 ±0.06
1.25≦t<1.60 ±0.05 ±0.06 ±0.06 ±0.06
1.60≦t<2.00 ±0.06 ±0.07 ±0.08 ±0.08
2.00≦t<2.50 ±0.07 ±0.08 ±0.08 ±0.09
2.50≦t<3.15 ±0.08 ±0.09 ±0.09 ±0.10
3.15或以上 ±0.09 ±0.10 ±0.10 ±0.11

5. 回火等級記號
回火等級記號硬  度
HRB HV
退火 A 57 (最大) 105 (最大)
標準級回火 S 65 (最大) 115 (最大)
八分之一硬 8 50-71 95-130
四分之一硬 4 65-80 115-150
二分[之一硬 2 74-89 135-185
全硬 1 85 (最小) 170 (最小)

6. 表面效果
表面效果記號註  解
陰暗表面 D 幼微粒輾延表面(俗稱單光)
光亮表面 B 极光滑輾延表面(俗你雙光)

7. 包裝及采購標記法
(例) JIS-SPCCT--2--D--厚x寬x長--數量
   訂購數量(張數或重量)
      尺寸規格(厚,寬,長實數)
      表面效果(陰暗面,單光)
      回火等級(二分之一硬度)
          品質標記(一般應用性質,機械性能經鑑證)

1.1.2  (JIS G3313) 電解鍍鋅鋼板料及捲料
Electrolytic zinc-coated steel sheets and coils

1. 品質分類
品質標記厚度應用
主要用途與JIS標準相符基材
SECC 0.4至3.2 一般應用品質,影印機、錄音機等內部零件． SPCC
SPCD 0.4至3.2 壓延面形用品質,電器箱,門鎖,時鐘外殼等. SPCD
SPCE 0.4至3.2 深壓延拉伸品質,摩打殼,各種深拉伸容器等. SPCE
備注：
1. 標準回火處理的SPCC品質經采購者要求證明它可達到某拉力測試數值會在標記後加上’T’成為SPCCT.
2. 標準回火及退火處理的SPCE品質經采購者要求證明它具有無時放作用會在標記後加上’N’成為SPCEN.

2. 相對其他國的對照
國家規格標記
JIS SPCC SPCD SPCE
ASTM A591/A591M-89 -------- --------
BS EN10152-94 -------- --------
DIN EN10152-93 -------- --------
ISO 5002-82 -------- --------

3. 化學成份
品質標記碳  C 錳  Mn 磷  P 硫  S
SPCC(SECC) 0.12 最大 0.50  最大 0.040  最大 0.045  最大
SPCD(SECD) 0.10 最大 0.45  最大 0.035  最大 0.035  最大
SPCE(SECE) 0.08 最大 0.40  最大 0.030  最大 0.030  最大

      4a. 片材厚度公差 (級別B)       單位: mm
寬度厚度(t) 160以下 160或以下至不包括250 250或以上至不包括400 400或以上至不包括630
0.40≦t<0.60 ±0.035 ±0.040 ±0.040 ±0.040
0.60≦t<0.80 ±0.040 ±0.045 ±0.045 ±0.045
0.80≦t<1.00 ±0.04 ±0.05 ±0.05 ±0.05
1.00≦t<1.25 ±0.05 ±0.05 ±0.05 ±0.06
1.25≦t<1.60 ±0.05 ±0.06 ±0.06 ±0.06
1.60≦t<2.00 ±0.06 ±0.07 ±0.08 ±0.08
2.00≦t<2.50 ±0.07 ±0.08 ±0.08 ±0.09
2.50≦t<3.15 ±0.08 ±0.09 ±0.09 ±0.10
3.15≦t<3.20 ±0.09 ±0.10 ±0.10 ±0.11

           4b. 相等鍍鋅厚度          單位: mm
單面鍍鋅質量記號 EB E8 E16 E24 E32 E40
相等鍍鋅厚度(單面) 0 0.001 0.003 0.004 0.005 0.006

5. 回火等級記號
回火等級記號硬  度
HRB HV
退火 A 57 (最大) 105 (最大)
標準級回火 S 65 (最大) 115 (最大)
八分之一硬 8 50-71 95-130
四分之一硬 4 65-80 115-150
二分[之一硬 2 74-89 135-185
全硬 1 85 (最小) 170 (最小)

6. 表面處理
表面處理記號
無處理 M
鉻化處理 C
磷化處理 P

7. 包裝及采購標記法
(例) JIS-SECEN--P—E16--厚x寬x長--數量
   訂購數量(張數或重量)
      尺寸規格(厚,寬,長實數)
      鍍鋅厚度(單面0.003mm)
      表面處理(磷化處理)
          品質標記(深壓延拉伸品質,無時效作用性質已經鑑證)

作者: chenjian1 时间: 2006-1-22 19:26
标题: 材料使用率计算
;;;********************************************************************1
;;;材料使用率计算  Command:Userx
;;;Enter "W" and "P";
;;;2004-01-07    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:userx (/ pt aa ww pp en1 area1 user en1-data en1-type tx)
  (setvar "cmdecho" 0)
  (setq ww (getdist "\n料宽 W: "))
  (if (= nil ww)
(sub-quit)
  )
  (setq pp (getdist "\n送距 P: "))
  (if (= nil pp)
(sub-quit)
  )
  (setq area1 (* ww pp))
  (setq pt (getpoint "\n点取产品展开轮廓内点!"))
  (if (= nil pt)
(sub-quit)
  )
  (command "bpoly" pt "")
  (setq en1 (entlast))
  (setq en1-data (entget en1))
  (setq en1-type (cdr (assoc 0 en1-data))) ;群码0为对象类型
  (if (or (= en1-type "REGION") (= en1-type "LWPOLYLINE"))
(progn
   (command "change" en1 "" "p" "c" "1" "")
   (command "area" "o" en1)
   (setq aa (getvar "area"))
   (redraw en1 3)
   (setq user (* 100 (/ aa area1)))
   (setq tx (strcat "*料宽W:"
         (rtos ww 2 2)
         " *送距P:"
         (rtos pp 2 2)
         " **材料使用率:"
         (rtos user 2 3)
         "%"
         )
   )
   (princ "\n")
   (princ tx)
   (if (> user 100.0)
(princ "\n------------ 有误! ------------ ")
(command "text" pt 2.5 0 (strcat "User=" (rtos user 2) "%"))
   )

)
  )
  (command "regen")
  (prin1)
)

作者: chenjian1 时间: 2006-1-22 19:29
;;;********************************************************************1
;;;制做扣位沉头 command c:GG
;;;2004-05-18    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:gg(/ pt1 pt2 os pt3 pt4 pt5 pt6)
  (setvar "cmdecho" 0)
  (setq pt1
   (getpoint "\nEnter first point:")
)
  (setq pt2
   (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 制做扣位沉头------------")
  (prin1)
)

作者: DAI-ZHI-BING 时间: 2006-1-22 22:37
多谢楼主!

作者: chenjian1 时间: 2006-1-23 00:29
标题: 这个程序应该很实用阿，有空给大家演示一下哈
;;;当我们设计好剪口后就该用它了，预设镶件壁厚为5.0mm,自动取整
;;;镶件外形生成 Command:WX
;;;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
         )
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (C:GETBOX)
  (if (= des-GetBox-OK 1)
(progn
   (setq pt1 des-GetBox-top-pt1)
   (setq pt2 des-GetBox-bottom-pt2)
   (setq pt3 des-GetBox-left-pt3)
   (setq pt4 des-GetBox-right-pt4)

   (setq Y1 (cadr pt1))
   (setq Y2 (cadr pt2))
   (setq midY (/ (+ Y1 Y2) 2.0))       ;中点Y坐标
   (setq lineY (+ (/ (fix (abs (- Y1 Y2))) 2.0) 5.5))
   (setq newY1 (+ midY lineY))
   (setq newY2 (- midY lineY))

   (setq X1 (car pt3))
   (setq X2 (car pt4))
   (setq midX (/ (+ X1 X2) 2.0))       ;中点X坐标
   (setq lineX (+ (/ (fix (abs (- X2 X1))) 2.0) 5.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)
   (command "undo" "e")
)
(Princ "\n------无对象?!")
  )
  (Princ "\n-----------Bye c:WX 镶件外形生成------------")
  (prin1)
)
;;;********************************************************************1
;;;取得s最小包围框 Command:GetBox
;;;Return minpoint maxpoint des-GetBox-top-pt1 des-GetBox-bottom-pt2
;;;    des-GetBox-left-pt3 des-GetBox-right-pt4 des-GetBox-midpt
;;;2005-10-11    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:GetBox       (/ des-GetBox-en1 ename-name
               vlaobject-ename-name
            )
  (setq des-GetBox-en1 nil)
  (setq des-GetBox-OK nil)
  (setq des-GetBox-en1 (entsel "\n选取图形... "))
  (vl-load-com)
  (while des-GetBox-en1
;;;当en1存在时，做以下内容，直到en1不存在为止
(sub-GetBoundingBox des-GetBox-en1)
(setq des-GetBox-en1 nil)
  )
  (prin1)
)

(defun sub-GetBoundingBox (des-GetBox-en1)
;;;  (command "ucs" "w")
  (setq ename-name (car des-GetBox-en1))
  (setq       vlaobject-ename-name
      (vlax-ename->vla-object ename-name)
  )
  (vla-GetBoundingBox
vlaobject-ename-name
'minpoint
'maxpoint
  )
  (setq minpoint (vlax-safearray->list minpoint))
  (setq maxpoint (vlax-safearray->list maxpoint))
  (setq minpoint(trans minpoint 0 1))    ;转为ucs点
  (setq maxpoint(trans maxpoint 0 1))    ;转为ucs点
  (setq des-GetBox-top-pt1 maxpoint)
  (setq des-GetBox-bottom-pt2 minpoint)
  (setq des-GetBox-left-pt3 minpoint)
  (setq des-GetBox-right-pt4 maxpoint)
  (setq des-GetBox-midpt (polar minpoint
      (angle minpoint maxpoint)
      (/(distance minpoint maxpoint) 2.0)
      ))
  (setq des-GetBox-OK 1)
  (princ "\nReturn-BoundingBox-ok")
)
;;;DES:ChenJian
;;;E-mail:ChenJianCaiHong@163.com

作者: chenjian1 时间: 2006-1-23 21:30
看来同行不多阿

作者: chenjian1 时间: 2006-1-23 21:37
标题: 常用材料标准
常用材料标准

作者: fwell 时间: 2006-1-23 21:46
;;;当我们设计好剪口后就该用它了，预设镶件壁厚为5.0mm,自动取整
;;;镶件外形生成 Command:WX
这个不是很好用

作者: fwell 时间: 2006-1-23 21:50
制做扣位沉头 command c:GG
这个指令应该还可以修该一下,只要点选一点即可

作者: chenjian1 时间: 2006-1-23 22:19
;;;当我们设计好剪口后就该用它了，预设镶件壁厚为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)
)

作者: chenjian1 时间: 2006-1-23 23:04
标题: 我使用的设置，可能与大家不同,讲讲你们的
我使用的设置，可能与大家不同,讲讲你们的

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 编辑 ]

作者: chenjian1 时间: 2006-1-23 23:44
集中一下

;;;********************************************************************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输入角度值: "))
)

作者: ckokaya 时间: 2006-1-24 07:40
thanks

作者: chenjian1 时间: 2006-1-24 20:53
这个指令应该还可以修该一下,只要点选一点即可

已修改
;;;********************************************************************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 制做扣位沉頭------------")
)

作者: chenjian1 时间: 2006-1-25 12:55
标题: 增強性偏移 (复线偏单边)
;;;********************************************************************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 编辑 ]

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

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

作者: chenjian1 时间: 2006-1-25 13:50
快速切换图层的程序
;;;********************************************************************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)

)

作者: chenjian1 时间: 2006-1-25 13:54
爆搞笑

绝对让你笑破肚皮!爆搞笑的短信
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.一对恋人在山中被野人抓住说:你们吃掉对方的大便就放了你们。恋人做到了，归途中女人大哭，男人问其原因，女人伤心的说:你不爱我，不然你不会拉那么多!

作者: chenjian1 时间: 2006-1-31 20:17
标题: 翻孔设计标准
翻孔设计标准,供参考用

作者: chenjian1 时间: 2006-1-31 20:51
标题: 模板孔自動對齊座標標注
模板孔自動對齊座標標注

;;;********************************************************************1
;;;原作者不詳,我改了一下,就叫 [模板孔自動對齊座標標注] 吧
;;;模板孔自動對齊座標標注 command c:AD1
;;;2006-01-03    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:AD1 ()
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq pto '(0 0 0))
  (setq oldmode (getvar "osmode"))
  (if (null the-plate-rightpt)
(setq the-plate-rightpt (getpoint "\n模板右上角: "))
  )
  (princ "\n當前模板大小---")
  (princ the-plate-rightpt)
  (setq pt1 the-plate-rightpt)
  (setq pt2 (list 0 0))
  (setq pt1x (car pt1))
  (setq pt1y (cadr pt1))
  (setq pc1 pto)
  (setq pc2 the-plate-rightpt)
  (command "zoom" "all")
  (setq sel1 (ssget "c"
      pc1
      pc2
      )
  )
  (command "zoom" "p")
  (grdraw '(0 0) (list pt1x 0) 1)
  (grdraw (list pt1x 0) pt1 1)
  (grdraw pt1 (list 0 pt1y) 1)
  (grdraw (list 0 pt1y) '(0 0) 1)
  (setvar "osmode" 0)
  (setq dwgsc 1.0)
  (if (= nil texth)
(setq texth 2.5)
  )
  (setvar "dimtxt" texth)
  (setq txth (/ texth dwgsc))
  (setq Acc 1)
  (setq ptox (car pc1)
ptoy (cadr pc1)
  )
  (setq ptcx (car pc2)
ptcy (cadr pc2)
  )
  (setq dlen (/ 5 dwgsc))
  (setq phtlx -10000.0
phtly -100000.0
phtrx -100000.0
phtry -100000.0
  )
  (autodim)
  (setvar "osmode" oldmode)
  (Princ
"\n---Bye c:AD1 模板孔自動對齊座標標注---"
  )
  (command "undo" "e")
  (prin1)
)

作者: chenjian1 时间: 2006-1-31 20:54
标题: 模板孔自動對齊座標標注-SUB
模板孔自動對齊座標標注-SUB

;;;********************************************************************1
;;;原作者不詳,我改了一下,就叫 [模板孔自動對齊座標標注] 吧
;;;模板孔自動對齊座標標注 command c:AD1
;;;2006-01-03    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA

;;;;;;;;;;;;;;;;;;;;;;;;;;;SUB
(defun compare (pt1 pt2)
  (setq pt1x (car pt1)
pt1y (cadr pt1)
  )
  (setq pt2x (car pt2)
pt2y (cadr pt2)
  )
  (if (> 0.0001 (abs (- pt1x pt2x)))
(progn
   (setq comp "VER")
   (if (< pt1y pt2y)
(if (< (abs (- leny2 pt2y)) (abs (- pt1y leny1)))
   (setq ptdim pt2
leny  leny2
   )
   (setq ptdim pt1
leny  leny1
   )
)
(if (< (abs (- leny2 pt1y)) (abs (- pt2y leny1)))
   (setq ptdim pt1
leny  leny2
   )
   (setq ptdim pt2
leny  leny1
   )
)
   )
)
(setq comp "DIFF")
  )
  (if (> 0.0001 (abs (- pt1y pt2y)))
(progn
   (setq comp "HOR")
   (if (< pt1x pt2x)
(if (< (abs (- lenx2 pt2x)) (abs (- pt1x lenx1)))
   (setq ptdim pt2
lenx  lenx2
   )
   (setq ptdim pt1
lenx  lenx1
   )
)
(if (< (abs (- lenx2 pt1x)) (abs (- pt2x lenx1)))
   (setq ptdim pt1
lenx  lenx2
   )
   (setq ptdim pt2
lenx  lenx1
   )
)
   )
)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;SUB
;;vertical dimension
;;input origin vertical texthigh accurate point
(defun dimhor (Pv PVt)
  (setq V (rtos (abs (- (cadr PVt) (cadr Pto))) 2 Acc))
  (setq L (abs (- PV (car PVt))))
  (setq Lg (/ Txth 2))
  (cond
((> PV (car PVt))
   (if (>= (- (cadr pvt) phtry) txth)
   (progn
   (setq pt1 (list (+ (car PVt) 0) (- (cadr PVt) (cadr Pto))))
   (setq pt2 (list (- PV Lg) (cadr PVt)))
   (setq pt3 (list PV (- (cadr PVt) (/ Txth 3))))
   (command "DIM" "ORD" pt1 pt2 "" "exit")
   (setq phtry (cadr pt2))
   )
   (progn
   (setq pt1 (list (+ (car PVt) Lg) (- (cadr PVt) (cadr Pto))))
   (setq pt2 (list (- pv (/ 10 dwgsc)) (cadr pvt)))
   (setq pt3 (list (- pv (/ 5 dwgsc)) (+ phtry (* 1.5 txth))))
   (setq pt4 (list (- pv lg) (+ phtry (* 1.5 txth))))
   (setq pt5 (list pv (- (+ phtry (* 1.5 txth)) (/ Txth 3))))
   (command "DIM" "ORD" pt1 pt4 "" "exit")
   (setq phtry (cadr pt4))
   )
   )
)
(t
   (if (>= (- (cadr pvt) phtly) txth)
   (progn
   (setq pt1 (list (- (car PVt) 0) (- (cadr PVt) (cadr Pto))))
   (setq pt2 (list (+ PV Lg) (cadr PVt)))
   (setq pt3 (list PV (- (cadr PVt) (/ Txth 3))))
   (command "DIM" "ORD" pt1 pt2 "" "exit")
   (setq phtly (cadr pt2))
   )
   (progn
   (setq pt1 (list (- (car PVt) 0) (- (cadr PVt) (cadr Pto))))
   (setq pt2 (list (+ pv (/ 10 dwgsc)) (cadr pvt)))
   (setq pt3 (list (+ pv (/ 5 dwgsc)) (+ phtly (* 1.5 txth))))
   (setq pt4 (list (+ pv lg) (+ phtly (* 1.5 txth))))
   (setq pt5 (list pv (- (+ phtly (* 1.5 txth)) (/ Txth 3))))
   (command "DIM" "ORD" pt1 pt4 "" "exit")
   (setq phtly (cadr pt4))
   )
   )
)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;SUB
;;horizontal dimension
;;input origin horizontal texthigh accurate point
(defun dimver (Ph PHt)
  (setq H (rtos (abs (- (car PHt) (car Pto))) 2 Acc))

  (setq L (abs (- PH (cadr PHt))))
  (setq Lg (/ Txth 2))
  (cond
((> PH (cadr PHt))
   (if (>= (- (car pht) phtrx) txth)
   (progn
   (setq pt1 (list (- (car PHt) (car Pto)) (+ (cadr PHt) 0)))
   (setq pt2 (list (car PHt) (- PH Lg)))
   (setq pt3 (list (+ (car PHt) (/ Txth 3)) PH))
   (command "DIM" "ORD" pt1 pt2 "" "exit")
   (setq phtrx (car pt2))
   )
   (progn
   (setq pt1 (list (- (car PHt) (car Pto)) (+ (cadr PHt) 0)))
   (setq pt2 (list (car PHt) (- ph (/ 10 dwgsc))))
   (setq pt3 (list (+ phtrx (* 1.5 txth)) (- ph (/ 5 dwgsc))))
   (setq pt4 (list (+ phtrx (* 1.5 txth)) (- ph lg)))
   (setq pt5 (list (+ phtrx (* 1.5 txth) (/ Txth 3)) PH))
   (command "DIM" "ORD" pt1 pt4 "" "exit")
   (setq phtrx (car pt4))
   )
   )
)
(t
   (if (>= (- (car pht) phtlx) txth)
   (progn
   (setq pt1 (list (- (car PHt) (car Pto)) (- (cadr PHt) 0)))
   (setq pt2 (list (car PHt) (+ PH Lg)))
   (setq pt3 (list (+ (car PHt) (/ Txth 3)) PH))
   (Command "DIM" "ORD" pt1 pt2 "" "exit")
   (setq phtlx (car pt2))
   )
   (progn
   (setq pt1 (list (- (car PHt) (car Pto)) (- (cadr PHt) 0)))
   (setq pt2 (list (car PHt) (+ ph (/ 10 dwgsc))))
   (setq pt3 (list (+ phtlx (* 1.5 txth)) (+ ph (/ 5 dwgsc))))
   (setq pt4 (list (+ phtlx (* 1.5 txth)) (+ ph lg)))
   (setq pt5 (list (+ phtlx (* 1.5 txth) (/ Txth 3)) PH))
   (command "DIM" "ORD" pt1 pt4 "" "exit")
   (setq phtlx (car pt4))
   )
   )
)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;SUB
(defun dimpt (pt)
  (if (< (- (car pt) lenx1) (- lenx2 (car pt)))
(progn
   (setq comp "HOR")
   (compare2 comp pt lenx1)
)
(progn
   (setq comp "HOR")
   (compare2 comp pt lenx2)
)
  )
  (if (< (- (cadr pt) leny1) (- leny2 (cadr pt)))
(progn
   (setq comp "VER")
   (compare2 comp pt leny1)
)
(progn
   (setq comp "VER")
   (compare2 comp pt leny2)
)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;SUB
(defun autodim ()
  (if (< ptox ptcx)
(setq lenx1 (- ptox dlen)
   lenx2 (+ ptcx dlen)
)
(setq lenx2 (+ ptox dlen)
   lenx1 (- ptcx dlen)
)
  )
  (if (< ptoy ptcy)
(setq leny1 (- ptoy dlen)
   leny2 (+ ptcy dlen)
)
(setq leny2 (+ ptoy dlen)
   leny1 (- ptcy dlen)
)
  )
  (setq pltoh (list (list pto lenx1)))
  (setq pltov (list (list pto leny1)))
  (setq emno (sslength sel1))
  (setq count1 0)
  (while (/= count1 emno)
(progn
   (setq entno (ssname sel1 count1))
   (setq ent1 (entget entno))
   (setq ent0 (cdr (assoc '0 ent1)))
   (setq lnty (cdr (assoc '6 ent1)))
   (setq lnt8 (cdr (assoc '8 ent1)))
   (setq laty (cdr (assoc '0 laty)))

   (if (= ent0 "CIRCLE")
(progn
   (setq pt1z (cdr (assoc '10 ent1)))
   (setq pt1 (trans pt1z 0 1))
   (dimpt pt1)
)
   )
   (if (= ent0 "INSERT")
(progn
   (setq pt1z (cdr (assoc '10 ent1)))
   (setq pt1 (trans pt1z 0 1))
   (dimpt pt1)
)
   )
)
(setq count1 (+ count1 1))
  )

  (dimalh)
  (dimalv)

)
;;dimall
(defun dimalh ()
  (setq pltoh (reverse pltoh))
  (setq lenno (length pltoh)
no1 0
  )
  (while (< no1 lenno)
(setq dimda (nth no1 pltoh))
(setq ptd (car dimda))
(setq lend2 (cadr dimda))
(dimhor lend2 ptd)
(setq no1 (+ no1 1))
  )
  (command "DIMORDINATE" the-plate-rightpt "y" "@3.75,0")
)
(defun dimalv ()
  (setq pltov (reverse pltov))
  (setq lenn1 (length pltov)
no2 0
  )
  (while (< no2 lenn1)
(setq dimda1 (nth no2 pltov))
(setq ptd1 (car dimda1))
(setq lend1 (cadr dimda1))
(dimver lend1 ptd1)
(setq no2 (+ no2 1))
  )
  (command "DIMORDINATE" the-plate-rightpt "x" "@0,3.75")
)
;;compare the same data or not
(defun compare2 (hv ptp lena / no lis p1 p2 l1 l2)
  (setq p1 (car ptp)
p2 (cadr ptp)
ch "nil"
  )
  (if (= hv "HOR")
(progn
   (setq nol (length pltoh))
   (setq no 0)
   (while (and (/= ch "E") (<= no (- nol 1)))
(setq lis (nth no pltoh))
(setq l2 (cadr (car lis)))
(setq l3 (car (car lis)))
(setq lis1 (cadr lis))
(cond ((= l2 p2)
         (if (> (abs (- l3 lis1)) (abs (- p1 lena)))
   (setq pltoh (subst (list ptp lena) lis pltoh))
         )
         (setq ch "E")
      )
      ((> l2 p2)
         (if (= no (- nol 1))
   (progn
   (setq lis4 (reverse pltoh))
   (setq pltoh (reverse (cons (list ptp lena) lis4)))
   )
   (setq lisl lis)
         )
      )
      (T
         (if (/= no 0)
   (progn
   (setq lis2 (member lis pltoh))
   (setq lis3 (reverse (member lisl (reverse pltoh))))
   (setq lis2 (cons (list ptp lena) lis2))
   (setq pltoh (append lis3 lis2))
   (setq ch "E")
   )
   (progn
   (setq pltoh (cons (list ptp lena) pltoh))
   (setq ch "E")
   )
         )
      )
)
(setq no (+ no 1))
   )
)
(progn
   (setq nol (length pltov))
   (setq no 0)
   (while (and (/= ch "E") (<= no (- nol 1)))
(setq lis (nth no pltov))
(setq l2 (car (car lis)))
(setq l3 (cadr (car lis)))
(setq lis1 (cadr lis))
(cond ((= l2 p1)
         (if (> (abs (- l3 lis1)) (abs (- p2 lena)))
   (setq pltov (subst (list ptp lena) lis pltov))
         )
         (setq ch "E")
      )
      ((> l2 p1)
         (if (= no (- nol 1))
   (progn
   (setq lis5 (reverse pltov))
   (setq pltov (reverse (cons (list ptp lena) lis5)))
   )
   (setq lisl lis)
         )
      )
      (T
         (if (/= no 0)
   (progn
   (setq lis2 (member lis pltov))
   (setq lis3 (reverse (member lisl (reverse pltov))))
   (setq lis2 (cons (list ptp lena) lis2))
   (setq pltov (append lis3 lis2))
   (setq ch "E")
   )
   (progn
   (setq pltov (cons (list ptp lena) pltov))
   (setq ch "E")
   )
         )
      )
)
(setq no (1+ no))
   )
)
  )
)

作者: chenjian1 时间: 2006-2-1 19:49
我设计的模具-内勾的弹片，产品剪口外形公差0.02

作者: TWINPEN 时间: 2006-2-3 08:36
不錯,很欣賞!我有大量的lisp程序,可以交流
qq:253351316

作者: chenjian1 时间: 2006-2-3 12:37
谢谢
我不用QQ,没那么多时间。写程序的目的是要解决工作中的问题，如你有实用的东西可以贴出来给大家

作者: chenjian1 时间: 2006-2-3 13:00
标题: 零件編號
零件編號

;;;********************************************************************1
;;;零件編序號
;;;command: PARTNO1
;;;2005-12-06 Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c

ARTNO1 (/ i dia inpoint temptxt ss ssn sstyp box dda cen p1 p2
   p3 p4)
  (setvar "cmdecho" 0)
  (setq i nil)
  (setq i (getint "Enter a start number<1>:"))
  (if (null i)
(setq i 1)
  )
  (setq dia 10)
  (Princ "\n---Enter---to  EXIT...")
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq inpoint (getpoint))
  (while inpoint
(setq temptxt (rtos i 2 0))
(if (< i 100)
   (setq temptxt (strcat "0" (rtos i 2 0)))
)
(if (< i 10)
   (setq temptxt (strcat "00" (rtos i 2 0)))
)
(command "text" inpoint 3.0 "" temptxt)
(setq ss (ssget "L"))
(setq ssn (ssname ss 0))
(setq ssdata (entget ssn))
(setq sstyp (cdr (assoc 0 ssdata)))
(if (= sstyp "TEXT")
   (progn
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq dda (+ (/ (distance p1 p2) 2) 1))
(setq cen (inters p1 p3 p2 p4))
(command "circle" cen (* dia 0.5))
(command "ucs" "

")
   )
)
(setq i (1+ i))
(setq inpoint nil)
(setq inpoint (getpoint))
  )
  (setvar "osmode" os)
;;;  (command "ucs" "")
  (Princ
"\n---------------Bye c

ARTNO1 零件編號---------------"
)
(prin1)
)

作者: lfh308533029 时间: 2006-2-4 13:28
楼主别把软件里的程序资料放在这里逗大家了，要么就传个软件上来嘛

作者: lfh308533029 时间: 2006-2-4 13:30
你这些都是抄软件上的东西，没意思

作者: chenjian1 时间: 2006-2-4 18:16
源程序你不要你要什么？
是我自己开发的，不是抄的。

作者: chenjian1 时间: 2006-2-4 18:18
我主要目的是连续模，不是软件

作者: lfh308533029 时间: 2006-2-5 08:18
哦，误会，误会，因为你的源程序与我用的TWCAD里的差不多，也就。。。

作者: chenjian1 时间: 2006-2-5 19:58
你很牛，居然能看到TWCAD的源程序！

作者: chenjian1 时间: 2006-2-5 20:47
我认为开的比较成功的一套模，与大家分享，希望大家多提议见

作者: chenjian1 时间: 2006-2-7 18:51
明天发生成孔表的程序，已做通用化处理，再贴点图。
好像大家的兴趣不高啊，不会大家都是菜鸟吧

作者: chenjian1 时间: 2006-2-8 22:32
全自动标注模板孔

作者: chenjian1 时间: 2006-2-8 22:42
模板自动对齐坐标标注

[ 本帖最后由 chenjian1 于 2006-2-8 14:43 编辑 ]

作者: chenjian1 时间: 2006-2-8 22:49
c:WORD 常用词库(可修改词库文件wordlist*.txt)

作者: chenjian1 时间: 2006-2-8 22:56
c:WORD 常用词库(可修改词库文件wordlist*.txt)

LISP文件
;;;********************************************************************1
;;;常用词词库
;;;command: WORD
;;;2006-01-19    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:WORD (/ inspt       mlist1    mlist2       word_list1
         word_list2 pophh_list    popang_list  wordstr
      data1 data2 ff)
  (setvar "cmdecho" 0)
  (setq oldsty (Getvar "textstyle"))
  (setq mlist1 nil)
  (setq mlist2 nil)
  (setq ff
   (open "D:\\DIE-DES\\BLOCK\\wordlist1.txt"
         "r"
   )
  )
  (setq data1 (read-line ff))
  (while data1
(setq mlist1 (cons data1 mlist1))
(setq data1 (read-line ff))
  )
  (close ff)
  (setq ff
   (open "D:\\DIE-DES\\BLOCK\\wordlist2.txt"
         "r"
   )
  )
  (setq data2 (read-line ff))
  (while data2
(setq mlist2 (cons data2 mlist2))
(setq data2 (read-line ff))
  )
  (close ff)
  (setq word_list1
   (reverse mlist1)
  )
  (setq word_list2
   (reverse mlist2)
  )
  (setq pophh_list '("1.5" "2" "2.5" "3" "3.5" "5" "10"))
  (setq popang_list '("0" "45" "90" "-45"))
  (chk_style)
  (dcl_word)
  (setvar "textstyle" oldsty)
  (prin1)
)
(defun dcl_word ()
  (setq dcl_id (load_dialog "word"))
  (new_dialog "word" dcl_id)
  (show_list "klist1" word_list1)
  (show_list "klist2" word_list2)
  (show_list "pophh" pophh_list)
  (show_list "popang" popang_list)
  (action_tile "klist1" "(sub_klist1 $value)")
  (action_tile "klist2" "(sub_klist2 $value)")
  (action_tile "pophh" "(sub_pophh $value)")
  (action_tile "popang" "(sub_popang $value)")
  (action_tile "accept" "(ok_word)(done_dialog 1)")
  (set_tile "txthh" (rtos  (getvar "textsize") 2 1))
  (set_tile "txtang" "0")
  (setq dd (start_dialog))
  (if (and (= dd 1) (/= wordstr ""))
(progn
   (setvar "textsize" (atof txthh))
   (setq inspt (getpoint "文字写入点:"))
   (if inspt
(command "text" inspt txthh txtang wordstr)
(Princ "\n---未指定写入点,操作取消!---")
   )
)
(Princ "\n---未写入任何文字---")
  )
  (Princ
"\n---Bye c:WORD 常用词库(可修改词库文件wordlist*.txt)---"
  )
)

DCL文件
word:dialog{
label="常用词";
:row{
:list_box{
label="词库1";
key="klist1";
width=20;
height=30;
fixed_width_font=true;
}
:list_box{
label="词库2";
key="klist2";
width=20;
height=30;
fixed_width_font=true;
}}
:edit_box{label="组合 ";key="wordstr";height=1.3;}
:row{
fixed_width=true;
alignment=centered;
:edit_box{label="字高";key="txthh";edit_width=4;}
:popup_list{ //下拉选单1
key="pophh";
edit_width=4;
}
:edit_box{label="角度";key="txtang";edit_width=4;}
:popup_list{ //下拉选单2
key="popang";
edit_width=4;
}
}
spacer_1;
ok_cancel;
}

作者: chenjian1 时间: 2006-2-8 22:58
;;;取得任意两点之间的中点，作φ2.1穿线孔

;;;********************************************************************1
;;;取得任意两点之间的中点，作φ2.1穿线孔 Command:zdd
;;;Version 1.0
(defun c:zdd (/ pt1 i)
  (setvar "cmdecho" 0)
  (sub-chk-layer1 chklay)
  (setq pt1 (get-midpt pt1 pt2)) ;取得任意两点之间的点
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (command "circle" pt1 "d" 2.1)
  (command "change" (entlast) "" "p" "c" "11" "")
  (setvar "osmode" os)
  (princ
"\n----------Bye c:ZDD 取得中点,作φ2.1穿线孔!---------"
  )
  (prin1)
)

作者: chenjian1 时间: 2006-2-8 23:03
计算展开长度,绘制展开线

;;;********************************************************************1
;;;计算展开长度,绘制展开线
;;;command: ZKL
;;;2005-12-24    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:ZKL (/ en1 en1-data en1-ccolor ss i sum en dd h pt area)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq ss (ssget))
  (if ss
(progn
   (setq i 0)
   (setq sum 0)
   (repeat (sslength ss)
(setq en (ssname ss i))
(command "lengthen" en "")
(setq dd (getvar "perimeter"))
(setq sum (+ sum dd))
(setq i (1+ i))
   )
   (command "LINE" "0,0" (list sum 0) "")
   (command "change" (entlast) "" "p" "c" 2 "")
   (setq oldORTHOMODE (getvar "ORTHOMODE"))
   (setvar "ORTHOMODE" 0)
   (Princ "\n请选择放置点...")
   (command "MOVE" (entlast) "" '(0 0) PAUSE)
   (setvar "ORTHOMODE" oldORTHOMODE)
   (princ (strcat "\n展开长度=" (rtos sum 2)))
)
  )
  (command "undo" "e")
  (Princ
"\n---------------Bye c:ZKL 计算展开长度,绘制展开线---------------"
  )
  (prin1)
)

作者: chenjian1 时间: 2006-2-8 23:05
自动标注模孔坐标

;;;********************************************************************1
;;;自动标注模孔坐标
;;;command: AD
;;;2004-01-13    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:ad (/ ss xx chkdim os i en1 en1-data pt rad pty)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq ss (ssget '((0 . "CIRCLE")))) ;创建圆对象的选择集
  (if (null ss)
;;; (sub-quit)
(Princ "\n---无对象哦!")
(progn
   (setq xx "autodim")
   (sub-chk-style chksty)
   (setvar "TEXTSTYLE" "autodim")
   (setq chkdim (tblsearch "dimstyle" "autodim"))
   (if (= chkdim nil)
(command "dimstyle" "s" "autodim")
   )
   (setvar "DIMTXSTY" "autodim")
   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
;;;    (command "ucs" "")
   (setq i 0)
   (repeat (sslength ss)
(setq en1 (ssname ss i))
(sub-dim en1)
(setq i (1+ i))
   )
   (setq ss nil)
   (setvar "osmode" os)
;;;    (command "ucs" "p")
)
  )
  (command "undo" "e")
  (Princ
"\n---------------Bye c:AD 自动标注模孔坐标---------------"
  )
  (prin1)
)

作者: chenjian1 时间: 2006-2-14 18:53
此为一快速开孔程式，（公夹板，脱料背板+1.0/s，脱料板）,如果图层名不一样须自行修改

;;;************************************************************************E
;;;向下成形制作>上模  Command:ShapeU1
;;;Shape punch
;;;2004-02-07    Chen Jian
;;;MADE IN CHINA
(defun C:ShapeU1(/ en1 en1-data en1-type os)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq en1 (entsel "\n選取成形公外形... "))
  (while en1 ;;;當en1存在時，做以下迴圈內容，直到en1不存在止
(setq en1-data (entget (car en1)))
(setq en1-type (cdr (assoc 0 en1-data))) ;群碼0為對象類型
(if (= en1-type "LWPOLYLINE")(sub-shapeu-LWPOLYLINE1))
(if (= en1-type "CIRCLE")(sub-shapeu-circle1))
(setq en1 (entsel "\n選取成形公外形... ")))
(setvar "osmode" os)
(command "undo" "e")
  (Princ "\n---------------Bye c:ShapeU1 向下成形制作>上模---------------")
  (prin1)
  )
(defun sub-shapeu-LWPOLYLINE1()
  (sub-chk-layer1 chklay)
  (command "change" en1 "" "p" "la" "layout" "C" "2" "")
  ;;;05-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "05-01" "c" "1" "")    ;Color is red
  ;;;06-01
  (command "offset" "1" en1 "-1000,-1000" "")
  (command "change" (entlast) "" "p" "la" "06-01" "c" "3" "")    ;Color is green
  ;;;07-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "07-01" "c" "1" "")    ;Color is red
  (princ "\n******{07-->>05} [ShapeU1 OK!]******")
  )
(defun sub-shapeu-circle1()
  (sub-chk-layer1 chklay)
  (command "change" en1 "" "p" "la" "layout" "C" "2" "")
  ;;;05-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "05-01" "c" "1" "")    ;Color is red
  ;;;06-01
  (command "offset" "1" en1 "-1000,-1000" "")
  (command "change" (entlast) "" "p" "la" "06-01" "c" "7" "")    ;Color is black
  ;;;07-01
  (command "copy" en1 ""  "0,0" "")
  (command "change" (entlast) "" "p" "la" "07-01" "c" "1" "")    ;Color is red
  (princ "\n******{07-->>05} [ShapeU1 OK!]******")
  )

作者: chenjian1 时间: 2006-2-20 22:58
标题: 模板外形生成1
模板外形生成1

;;;********************************************************************1
;;;模板外形生成1  Command:plant1
;;;2004-02-02    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:plant1(/ en1 en1-data en1-type layname)
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq en1 (entsel "\n請選擇基板... "))
  (if en1    ;;;當en1存在時，做以下
(progn
   (setq en1-data (entget (car en1)))
   (setq en1-type (cdr (assoc 0 en1-data))) ;群碼0為對向類型
   (if (= en1-type "LWPOLYLINE")(sub-plant1)(sub-quit))
   ))
  (command "undo" "e")
  (Princ "\n---------------Bye c

lant1 模板外形生成1---------------")
  (prin1)
  )

(defun sub-plant1()
(sub-chk-layer1 chklay)
(setq i 2)
(while (< i 8)
   (if (= i 2)(setq layname "08-01"))
   (if (= i 3)(setq layname "07-01"))
   (if (= i 4)(setq layname "06-01"))
   (if (= i 5)(setq layname "05-01"))
   (if (= i 6)(setq layname "01-01"))
   (if (= i 7)(setq layname "02-01"))
   (command "copy" en1 ""  "0,0" "")
   (command "change" (entlast) "" "p" "la" layname "")
   (setq i (+ i 1))
  )
)

作者: chenjian1 时间: 2006-2-20 23:01
标题: 單行文字加圓
單行文字加圓

;;;********************************************************************1
;;;單行文字加圓 command c:txtcir
;;;2004-05-18    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:txtcir(/ dd ss i ssn ssdata sstyp box p1 p2 p3 p4 dda cen)
  (setvar "cmdecho" 0)
  (setq dd (getdist "\n輸入字間與圓周距離<1.5>: "))
  (if (null dd)
(setq dd 1.5)
)
  (setq ss (ssget))
  (if (null ss)(sub-quit))
  (setq i 0)
  (repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
(setq sstyp (cdr (assoc 0 ssdata)))
(if (= sstyp "TEXT")
   (progn
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq dda (+ (/ (distance p1 p2) 2) dd))
(setq cen (inters p1 p3 p2 p4))
(setq os (getvar "osmode"))
      (setvar "osmode" 0)
(command "circle" cen dda)
(setvar "osmode" os)
      (command "ucs" "P" )
)
   )
(setq i (1+ i))
)
  (Princ "\n---------------Bye c:TxtCir 單行文字加圓--------------")
  (prin1)
  )

作者: chenjian1 时间: 2006-2-20 23:02
标题: 做多線段的倒圓角
做多線段的倒圓角

;;;********************************************************************1
;;;The line to FILLET
;;;做多線段的倒圓角  comma: FA
;;;2004-06-01 Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:fa (/ rad)
  (setvar "cmdecho" 1)
(command "FILLET" "R" pause)
(command "FILLET" "P" PAUSE)
  (Princ "\n---------------Bye c:FA---------------")
  (prin1)
)

作者: kinghomewang 时间: 2006-2-20 23:48
楼主,请传自动完成模板说明的程式及尺寸标注对齐的程式,注明那CAD那个版本可用

作者: chenjian1 时间: 2006-2-21 12:49
尺寸标注对齐的程式还没有上面已有对齐标注尺寸的程式
大部分不用到vlx 扩展命令的程序可在AutoCAD2000-2005中使用
所有程序可在2005中使用

自动完成模板说明要根具具体的模具结构和要的样式来设计，我用的可能不适合你，你要说说你的要求

作者: tonywww 时间: 2006-2-21 17:11
頂........

作者: chenjian1 时间: 2006-2-25 12:59
这段时间没上来发东西，我搞了一个连续模个人论坛，感觉不是很爽，等我辞工到期再好好搞一下
如果哪位朋友有经验可以分享一下

作者: chenjian1 时间: 2006-2-28 20:46
看来真正在厂里搞模具设计，有时间上论坛的人并不多，能提意见的太少了

作者: chenjian1 时间: 2006-3-1 19:56
......

[ 本帖最后由 chenjian1 于 2006-3-10 05:05 编辑 ]

作者: chenjian1 时间: 2006-3-2 13:27
绘立体图技巧

作者: chenjian1 时间: 2006-3-8 23:58
标题: 模具点检表
模具点检表

作者: yqg_2006 时间: 2006-3-9 16:31
chenjian1 大哥你们哪里画CAD都不要求线宽的啊~~~~

作者: yqg_2006 时间: 2006-3-9 16:41
我晕这个系统时间显示有错~~~~~~~~~服务器是不是在美国哦~~~~

作者: chenjian1 时间: 2006-3-9 20:20
我这对线宽没有具体要求，一般零件用0.25，标注用0.15，图纸好辨认即可（主要用颜色区分如何加工）
现在基本都连网数控加工，只有磨床那里要详细看图

作者: chenjian1 时间: 2006-3-10 13:17
软件下载，用得着就顶一下

作者: liu760713 时间: 2006-3-10 18:50
楼主：能加你QQ吗？谢谢！
Q本361863762

作者: chenjian1 时间: 2006-3-10 22:47
我还没申请QQ,你可以到我的个人主页留言
https://chenjian1.id666.com/

作者: ZHONGFENG 时间: 2006-3-14 07:27
好资料!!顶啊!!
大开眼界!!!!!

作者: zhiwy 时间: 2006-3-17 20:53
厉害呀

作者: chenjian1 时间: 2006-3-22 10:06
算使用率

[ 本帖最后由 chenjian1 于 2006-3-22 07:03 编辑 ]

作者: chenjian1 时间: 2006-3-22 10:34
复线偏单边的改良版

作者: yaosi 时间: 2006-3-22 11:32
太高深了.
有點看不懂.
再就下載的附件也打不開啊.
樓主精神可嘉!
幫忙頂一下!

作者: chenjian1 时间: 2006-3-22 15:10
我的gif图没动，晕

作者: lijia66 时间: 2006-3-22 19:53
标题: LIJIA
666

作者: chenjian1 时间: 2006-4-6 19:55
明天开始上班了，byby

作者: 前生 时间: 2006-4-14 03:44
算是一个同行了.

作者: fmj81 时间: 2006-4-27 23:17
软件在哪啊

作者: jionpla 时间: 2006-5-1 17:40
兄弟,把你的软件发一份给我好不?
SUNNY-B1@163.COM
非常感谢!!!

作者: ywnbk 时间: 2006-5-2 22:45
很精彩

作者: ywnbk 时间: 2006-5-2 23:36
我永远支持你的无私精神！

作者: zhujin_930 时间: 2006-5-4 12:44
謝謝樓主

作者: shouxi 时间: 2006-5-11 12:40
楼主是否打算从此行洗手，3KU楼主的无私与勤奋!

作者: chenjian1 时间: 2006-5-11 22:13
是很辛苦，学了很久
计算机图形学，软件工程，c++,vc++,面向对象编程,MFC,LISP,VB,数据结构，算法，与专业结合......
现在还是搞设计

作者: 模具师傅 时间: 2006-5-14 19:46
什么啊，有人基与2002开发的XXPREES比你强多了效率也不知道高了多少倍

作者: chenjian1 时间: 2006-5-14 20:43
全名叫什么，拉出来看看

作者: goubeishu 时间: 2006-6-10 22:06
DING

作者: chenjian1 时间: 2006-6-11 19:51
;;;********************************************************************1
;;;标尺寸序号
;;;command: DA
;;;2005-10-05 Chen Jian
;;;Version 1.1 Add "Enter a start number<1>
;;;2005-08-25 Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c

A (/ i dia)
  (setvar "cmdecho" 0)
  (setq i nil)
  (setq dia nil)
  (setq i (getint "Enter a start number<1>:"))
  (if (null i)
(setq i 1)
  )
  (setq dia (getreal
      "Enter diameter<5>:"
      )
  )
  (if (null dia)
(setq dia 5)
  )
  (Princ "\n---Enter---to  EXIT...")
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq inpoint (getpoint))
  (while inpoint
(setq sc 0.5)
(if (> i 10)
   (setq sc 0.5)
)
(if (> i 99)
   (setq sc 0.4)
)
(command "text"
      inpoint
      (rtos (* sc dia) 2 1)
      ""
      (rtos i 2 0)
)

(setq ss (ssget "L"))
(setq ssn (ssname ss 0))
(setq ssdata (entget ssn))
(setq sstyp (cdr (assoc 0 ssdata)))
(if (= sstyp "TEXT")
   (progn
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq dda (+ (/ (distance p1 p2) 2) 1))
(setq cen (inters p1 p3 p2 p4))
(command "circle" cen (* dia 0.5))
(command "ucs" "

")
   )
)
(setq i (1+ i))
(setq inpoint nil)
(setq inpoint (getpoint))
  )
  (setvar "osmode" os)
;;;  (command "ucs" "")
  (Princ "\n---------------Bye c

A 标尺寸序号---------------"
)
(prin1)
)

作者: trouble801221 时间: 2006-6-12 14:23
LZ，我加载不成功是什么原因。
我的是2004

命令: _appload 已成功加载 des.VLX。
命令:
「Die-Des五金连续模设计」(AutoCAD2002-2005) V20060303
不可使用本软件.如有建议请E-mail:ChenJianCaiHong@163.com; 错误: quit / exit abort
命令:

作者: chenjian1 时间: 2006-6-14 23:28
把 Die-Des-Pass.lic 内的内容发个我看看我才知道

作者: qqhuang 时间: 2006-6-18 11:58
楼主是高手！只有佩服的份了！支持你！

作者: wangj32 时间: 2006-6-18 19:41
高手,

作者: jon_liu 时间: 2006-6-19 22:03
楼主，谢谢！我全部看完了，受益非浅，我的QQ是242515616，有机会咱们聊聊

作者: tajixiya 时间: 2006-6-20 10:58
可以参考

作者: chenjian1 时间: 2006-6-30 22:55
;;;********************************************************************1
;;;文字对齐  Command:ALTEXT
;;;2004-05-18    Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun c:altext (/    ss    pt1    i    enname    endata
   texthight    txt    txtsty    txtlen    newtxt
   txt1    txt4    txt5
)
  (command "undo" "be")
  (princ "\n请顺序选择要对齐的文字...")
  (setq ss (ssget
      '(
         (-4 . "<XOR")
         (0 . "text")
         (0 . "mtext")
         (-4 . "XOR>")
      )
   )
  ) ;创建文字对象的选择集text or mtext

  (if (null ss)
(sub-quit)
  )
  (setq pt1 (GETPOINT "\nPlease enter the base point:"))
  (if (null pt1)
(sub-quit)
  )

  (setq i 0)
  (repeat (sslength ss)
(setq enname (ssname ss i))
(setq endata (entget enname))
;;;(setq textbasept (cdr (assoc 10 endata)))
(setq texthight (cdr (assoc 40 endata)))
(setq txt (cdr (assoc 1 endata))) ; 取得原字符串
(setq txtsty (cdr (assoc 7 endata))) ; 取得原字符串样式
(setq txtlen (strlen txt))
(setq txt1 (substr txt 1 1)) ; 取得原字符串子串1
(setq txt4 (substr txt 4 1)) ; 取得原字符串子串4
(setq txt5 (substr txt 5 (- txtlen 4))) ; 取得原字符串子串5---
(setq i (1+ i))
(if (and (= txt1 "<") (= txt4 ">"))
   (if (< i 10)
(setq newtxt (strcat "<0" (rtos i 2 0) ">" txt5)) ;新字符串
(setq newtxt (strcat "<" (rtos i 2 0) ">" txt5)) ;新字符串
   )
   (if (< i 10)
(setq newtxt (strcat "<0" (rtos i 2 0) ">" txt)) ;新字符串
(setq newtxt (strcat "<" (rtos i 2 0) ">" txt))
   ) ;新字符串
)
(command "text" "s" txtsty pt1 texthight 0 newtxt)
(setq pt1 (polar pt1 (* pi 1.5) (+ texthight 1.5)))
  )
  (command "erase" ss "")
  (command "undo" "e")
  (Princ "\n---------------Bye c:AlText 文字对齐--------------")
  (prin1)
)

作者: corw 时间: 2006-8-23 19:56
可以請 chenjian1 兄上傳"全自动标注模板孔"及"模板自动对齐坐标标注"的lisp的程序嗎?因為我急需要用到,感謝不盡^^

作者: corw 时间: 2006-8-23 20:17
可以拜託chenjian1 兄幫我修改一下lisp好嗎?
此lisp只能讀取一班的圓形座標,可以修改成讀取block插入點座標嗎?不用標直徑
還有編號可以修改放在右上角嗎?
謝謝^^

作者: chenjian1 时间: 2006-8-24 21:41
好久没发了
;;;********************************************************************1
;;零件位置圆整  Command:FixPart
;;;2005-10-17 Chen Jian
;;;Version 1.1 Change in UCS
;;;2005-09-16 Chen Jian
;;;Version 1.0
;;;MADE IN CHINA
(defun C:FixPart (/       en1    en1-data en1-type
   direction INSERT-name INSERT-data INSERT-cenpt
   cptx       cpty    newcptx    newcpty
   os       i
   )
  (command "undo" "be")
  (setvar "cmdecho" 0)
  (setq en1 (entsel "\n选取要调整位置的零件(图块)... "))
  (setq direction nil)
  (setq i 1)
  (while en1
;;;当en1存在时，做以下内容，直到en1不存在为止
(setq en1-data (entget (car en1)))
(setq en1-type (cdr (assoc 0 en1-data))) ;群码0为对象类型
(if (= en1-type "INSERT")
   (sub-move-INSERT en1)
   (Princ "\n**************Sorry,不能调整此对象!")
)
(setq en1 (entsel "\n选取要调整位置的零件(图块)... "))
  )
  (command "undo" "e")
  (Princ "\n---------------Bye c:FixPart 零件位置圆整---------------")
  (prin1)
)

(defun sub-move-INSERT (en1)
  (if (null direction)
(setq
   direction
   (getint "\n请选择方向 [X方向(1)/Y方向(2)/XY方向(3)]<3>:")
)
  )
  (if (and (/= direction 1) (/= direction 2))
(setq direction 3)
  )
  (setq INSERT-name (car en1))
  (setq INSERT-data (entget INSERT-name))
  (setq INSERT-cenpt (cdr (assoc 10 INSERT-data))) ;求得圆心pt
  (setq INSERT-cenpt(trans INSERT-cenpt 0 1))          ;转为ucs
  (setq cptx (car INSERT-cenpt)) ;求得圆心pt的x坐标
  (setq cpty (cadr INSERT-cenpt)) ;求得圆心pt的y标
  (setq newcptx (fix cptx)) ;求得圆心pt的新x坐标
  (setq newcpty (fix cpty)) ;求得圆心pt的新y坐标
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (Princ (strcat "\n" "零件" (rtos i 2 0)))
  (if (= direction 1)
(progn
   (command "move"
         INSERT-name
         ""
         (list cptx cpty)
         (list newcptx cpty)
   )
   (Princ "\调整了X方向*X")
)
  )
  (if (= direction 2)
(progn
   (command "move"
         INSERT-name
         ""
         (list cptx cpty)
         (list cptx newcpty)
   )
   (Princ "\调整了Y方向**Y")
)
  )
  (if (= direction 3)
(progn
   (command "move"
         INSERT-name
         ""
         (list cptx cpty)
         (list newcptx newcpty)
   )
   (Princ "\调整了XY方向***XY")
)
  )
  (setq i (1+ i))
  (setvar "osmode" os)
)

欢迎光临 iCAx开思网 (https://www.icax.org/)