设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [源码]明细表，逐步添加程序
123456下一页
返回列表 发新帖
楼主: cabinsummer

[【风之影】] [源码]明细表，逐步添加程序

  [复制链接]
T_T
发表于 2012-4-14 03:54:47 | 显示全部楼层
风版的好复杂呢，留个记号，等消化力强些，再拿来慢慢消化。
回复 支持 反对

使用道具 举报

cabinsummer
 楼主| 发表于 2012-4-14 09:51:17 | 显示全部楼层
yjr111 发表于 2012-4-13 21:48
想请教一下，用EVAL求最大最小数时数值太多会出问题，所以有些时候要改为VL-SORT来求，但却不清楚EVAL究竟 ...

测试了一下，大概是在256个元素时出错。谢谢提醒，我要更新程序了
回复 支持 反对

使用道具 举报

wuhuyinwei
发表于 2012-4-14 16:16:08 | 显示全部楼层
留下脚印！做个记号！
回复 支持 反对

使用道具 举报

dwg001
发表于 2012-4-15 10:37:58 | 显示全部楼层
超有實用價值的源碼，贊一個！
回复 支持 反对

使用道具 举报

cabinsummer
 楼主| 发表于 2012-4-15 11:38:05 | 显示全部楼层
本帖最后由 cabinsummer 于 2012-4-15 11:51 编辑

今天贴第三个图片中实现的交互式操作，在已有标号附近选择，则自动判定方向，不会与原有的重叠在一起。其实就是控制驱动对话框中的p0、p1那一段。替换即可

  1. (setq p0 (getpoint "选择标号引线起点:\n"))
  2. (NEAP p0)
  3. (cond
  4.   (PF0
  5.     (cond
  6.       ((> (cadr p0)(cadr PF0)) (setq UD 0.5))
  7.       (T (setq UD -0.5))
  8.     )
  9.     (setq p1 (polar PF0 (* pi UD)(* 25.0 scl)) p0 PF0)
  10.   )
  11.   (T
  12.     (setq p1 (getpoint p0 "选择标号放置位置:\n"))
  13.     (NEAP p1)
  14.     (cond
  15.       (PF0
  16.         (cond
  17.           ((> (cadr p1)(cadr PF0))(setq UD 0.5))
  18.           (T (setq UD -0.5))
  19.         )
  20.         (setq p1 (polar PF0 (* pi UD)(* 25.0 scl)))
  21.       )
  22.       (T
  23.         (cond
  24.           ((> (cadr p1)(cadr p0))(setq UD 0.5))
  25.           (T (setq UD -0.5))
  26.         )
  27.         (cond
  28.           ((> (car p0)(car p1))(setq ID_SIDE "R"))
  29.           (T (setq ID_SIDE "L"))
  30.         )
  31.       )
  32.     )
  33.   )
  34. )
  35. (defun NEAP (PF / W1 W2 ss edata LR);;;PF附近已有标号则返回最近的标号插入点，同时给出方向ID_SIDE和UD。
  36.   (setq PF0 nil)
  37.   (setq W1 (mapcar '+ PF (list (* 10.0 scl) (* 10.0 scl) 0.0)))
  38.   (setq W2 (mapcar '+ PF (list (* -10.0 scl) (* -10.0 scl) 0.0)))
  39.   (setq ss (ssget "C" W1 W2 '((-4 . "<OR")(2 . "DTL-*")(2 . "STD-*")(2 . "IDT-*")(2 . "ASM-*")(-4 . "OR>"))))
  40.   (if ss
  41.     (progn
  42.       (setq edata (entget (ssname ss 0)) LR (cdr (assoc 2 edata)))
  43.       (setq PF0 (cdr (assoc 10 edata)) ID_SIDE (substr LR (strlen LR) 1))
  44.     )
  45.   )
  46. )

未完待续……
回复 支持 反对

使用道具 举报

fdb2007
发表于 2012-4-19 09:58:00 | 显示全部楼层
好东西，学习一下
回复 支持 反对

使用道具 举报

cabinsummer
 楼主| 发表于 2012-4-22 11:00:18 | 显示全部楼层
本帖最后由 cabinsummer 于 2012-4-22 17:35 编辑

已经有一周没有继续贴了，今天加上文字库部分

  1. (defun REM_BLANK (string);;;去除字符串中的空格
  2.   (apply 'strcat (mapcar 'vl-princ-to-string (read (strcat "(" string ")"))))
  3. )
  4. (defun FIRST_CHAR (string / fc)
  5.   (setq fc "")(foreach x (mapcar 'vl-princ-to-string (read (strcat "(" string ")"))) (setq fc (strcat fc (substr x 1 1))))
  6. )
  7. (defun config (/ para);;;配置规格
  8.   (setq par (get_tile "PAR"))
  9.   (setq para (mapcar 'vl-princ-to-string (read (strcat "(" par ")"))))
  10.   (cond
  11.     ((= typ "STD")(foreach x para (setq spc (vl-string-subst x "#" spc)))(set_tile "SPC" spc))
  12.     ((= typ "PUR")(foreach x para (setq cmc (vl-string-subst x "#" cmc)))(set_tile "CMC" cmc))
  13.   )
  14.   (setq par "")
  15.   (set_tile "PAR" par)
  16. )
  17. (defun show_list ();;;调用文字库到列表框显示
  18.   (setq act $key item_list (eval (read (strcat $key "_list"))))
  19.   (cond
  20.     ((= typ "STD")
  21.      (if (= com "")(setq com "xxxxxxxx"))
  22.      (set_tile "COM" com)
  23.      (if (= act "CMC")
  24.        (progn
  25.          (cond
  26.            ((= $value "GB/T 70.1-2000") (setq dsc "Hexagon socket head cap screw"))
  27.            ((= $value "GB 5783-86")     (setq dsc "Hexagon head bolt"))
  28.            ((= $value "GB/T 6170-2000") (setq dsc "Hexagon nut"))
  29.            ((= $value "GB/T 97.1-1985") (setq dsc "Plain Washer"))
  30.            ((= $value "GB/T 93-1987")   (setq dsc "Spring washer"))
  31.            ((= $value "GB/T 120.2-2000")(setq dsc "Parallel pin"))
  32.            ((= $value "GB/T 70.3-2000") (setq dsc "Hexagon socket countersunk head screw"))
  33.            ((= $value "GB/T 1096-1979") (setq dsc "Parallel Key"))
  34.            ((= $value "GB/T 77-2000")   (setq dsc "Hexagon socket set screw"))
  35.            ((= $value "GB/T 78-2000")   (setq dsc "Hexagon socket set screw"))
  36.            ((= $value "GB/T 79-2000")   (setq dsc "Hexagon socket set screw"))
  37.            ((= $value "GB/T 80-2000")   (setq dsc "Hexagon socket set screw"))
  38.          )
  39.          (set_tile "DSC" dsc)
  40.        )
  41.      )
  42.      (if (= act "SPC")
  43.        (cond
  44.          ((apply 'or (mapcar '(lambda (x) (wcmatch (get_tile "CMC") x)) '("GB/T 97*" "GB/T 93*")))(setq item_list (eval (read "WASHER"))))
  45.          ((apply 'or (mapcar '(lambda (x) (wcmatch (get_tile "CMC") x)) '("GB/T 70*" "GB/T 77*" "GB/T 78*" "GB/T 79*" "GB/T 80*" "GB 5783*")))(setq item_list (eval (read "SCREW"))))
  46.          (T (setq item_list (eval (read (REM_BLANK (get_tile "CMC"))))))
  47.        )
  48.      )
  49.      (if (= act "PAR")
  50.        (cond
  51.          ((and (not (wcmatch (get_tile "DSC") "*nut"))(wcmatch (get_tile "SPC") "M*"))(setq item_list (eval (read (get_tile "SPC")))))
  52.          (T (setq item_list (eval (read (strcat (substr (REM_BLANK (get_tile "CMC")) 1 8) "_" (REM_BLANK (get_tile "SPC")))))))
  53.        )
  54.      )
  55.     )
  56.     ((= typ "PUR")
  57.      (if (= act "DSC") (setq item_list (eval (read (REM_BLANK (get_tile "SPL"))))))
  58.      (if (= act "CMC") (setq item_list (eval (read (strcat (REM_BLANK (get_tile "SPL")) "_" (REM_BLANK (get_tile "DSC")))))))
  59.      (if (= act "PAR") (setq item_list (eval (read (strcat (REM_BLANK (get_tile "SPL")) "_" (REM_BLANK (get_tile "DSC")) "_" (REM_BLANK (get_tile "CMC")))))))
  60.     )
  61.   )
  62.   (set (read act) $value)
  63.   (start_list "LIB")
  64.   (mapcar 'add_list item_list)
  65.   (end_list)
  66. )
  67. (defun do_dialog ();;;这个对话框驱动去替换前面那个
  68.   (if (new_dialog "WZ_Label" DLG_ID)
  69.     (progn
  70.       (setq amt_list '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20"))
  71.       (set_tile "N" "1")
  72.       (action_tile "SPR_TYP" "(setq spr $value)")
  73.       (foreach x '("ASM" "IAM" "CAM" "DTL" "IDT" "CMN" "ANX" "STD" "PUR")(action_tile x "(setq typ $key)(do_list)"))
  74.       (foreach x '("SPL" "CMC" "COM" "DSC" "SPC" "AMT" "RMK" "PAR")(action_tile x "(show_list)"))
  75.       (action_tile "CFG" "(config)")
  76.       (action_tile "SEL" "(done_dialog)(setq SEL_TAG 2)")
  77.       (action_tile "CON" "(setq con $value)")
  78.       (action_tile "LIB" "(if (setq item (nth (atoi $value) item_list))(set_tile act item))(mode_tile act 2)")
  79.       (action_tile "accept" "(done_dialog 1)(setq TAG 1)")
  80.       (action_tile "cancel" "(done_dialog 0)(setq TAG 0 con \"0\")")
  81.       (start_dialog)
  82.     )
  83.     (princ "\nCan't display dialog.")
  84.   )
  85. )

  87. ;;;以下是文字库，这个比较简单，就是直接用表加载，对文字库的管理比较麻烦，后续会推出文本文件或Access版的
  88. (setq asm_list '((com_list "001ASM" "002ASM" "003ASM" "004ASM" "005ASM" "006ASM" "007ASM" "008ASM" "009ASM" "010ASM")
  89.                  (dsc_list "BASE" "BENCH" "FRAME" "SLIDE" "PRESS UNIT" "DRIVE UNIT" "LEVEL SCREW")))
  90. (setq iam_list '((dsc_list "BASE" "BENCH" "FRAME" "SLIDE" "PRESS UNIT" "DRIVE UNIT" "LEVEL SCREW")))
  91. (setq dtl_list '((com_list "001" "002" "003" "004" "005" "006" "007" "008" "009" "010" "011" "012" "013" "014" "015" "016" "017" "018" "019" "020")
  92.                  (dsc_list "LOCATOR" "CLAMP" "SHAFT" "PLATE" "BLOCK" "SPACER" "BRACKET" "BUSH" "GUIDE" "COVER")))
  93. (setq anx_list '((com_list "001" "002" "003" "004" "005" "006" "007" "008" "009" "010" "011" "012" "013" "014" "015" "016" "017" "018" "019" "020")
  94.                  (rmk_list "MACHINING" "PURCHASE DRAWING")))
  95. (setq idt_list '((com_list "")))
  96. (setq cmn_list '((rmk_list "PURCHASED")))
  97. (setq std_list '((cmc_list "GB/T 70.1-2000" "GB 5783-86" "GB/T 6170-2000" "GB/T 97.1-1985" "GB/T 93-1987" "GB/T 120.2-2000"
  98.                   "GB/T 70.3-2000" "GB/T 1096-1979" "GB/T 77-2000" "GB/T 78-2000" "GB/T 79-2000" "GB/T 80-2000")
  99.                  (GB/T6170-2000 "M5" "M6" "M8" "M10" "M12" "M16" "M20")
  100.                  (GB/T120 "6x#" "8x#" "10x#" "12x#")
  101.                  (GB/T120_6x# "16" "18" "20" "22" "24" "26" "28" "30" "32" "35" "40" "45" "50" "55" "60")
  102.                  (GB/T120_8x# "18" "20" "22" "24" "26" "28" "30" "32" "35" "40" "45" "50" "55" "60" "65" "70" "75" "80")
  103.                  (GB/T120_10x# "22" "24" "26" "28" "30" "32" "35" "40" "45" "50" "55" "60" "65" "70" "75" "80" "85" "90" "95" "100")
  104.                  (GB/T120_12x# "26" "28" "30" "32" "35" "40" "45" "50" "55" "60" "65" "70" "75" "80" "85" "90" "95" "100" "120")
  105.                  (GB/T1096-1979 "A4x4x#" "A5x5x#" "A6x6x#" "A8x7x#" "A10x8x#" "A12x8x#" "A14x9x#" "A16x10x#" "A18x11x#")
  106.                  (GB/T1096_A4x4x# "10" "12" "16" "25")
  107.                  (GB/T1096_A5x5x# "10" "12" "14" "16" "18" "20" "25" "32" "40")
  108.                  (GB/T1096_A6x6x# "14" "18" "20" "22" "25")
  109.                  (GB/T1096_A8x7x# "22" "25" "28" "32" "40" "45" "50")
  110.                  (GB/T1096_A10x8x# "22" "25" "28" "32" "40" "45" "50" "70")
  111.                  (GB/T1096_A12x8x# "40" "45" "50" "70" "80" "90")
  112.                  (GB/T1096_A14x9x#  "40" "45" "50" "70" "80" "90")
  113.                  (GB/T1096_A16x10x# "45" "50" "70" "80" "90" "100")
  114.                  (GB/T1096_A18x11x# "50" "70" "80" "90" "100" "110")
  115.                  (WASHER "5" "6" "8" "10" "12" "12" "16" "20")
  116.                  (SCREW "M5x#" "M6x#" "M8x#" "M10x#" "M12x#" "M16x#" "M20x#")
  117.                  (M5x# "8" "10" "12" "16" "20" "25" "30" "35" "40" "45" "50")
  118.                  (M6x# "10" "12" "16" "20" "25" "30" "35" "40" "45" "50" "55" "60")
  119.                  (M8x# "12" "16" "20" "25" "30" "35" "40" "45" "50" "55" "60" "65" "70" "80")
  120.                  (M10x# "16" "20" "25" "30" "35" "40" "45" "50" "55" "60" "65" "70" "80" "90" "100")
  121.                  (M12x# "20" "25" "30" "35" "40" "45" "50" "55" "60" "65" "70" "80" "90" "100" "110" "120")
  122.                  (M16x# "25" "30" "35" "40" "45" "50" "55" "60" "65" "70" "80" "90" "100" "110" "120" "130" "140" "150" "160")
  123.                  (M20x# "30" "35" "40" "45" "50" "55" "60" "65" "70" "80" "90" "100" "110" "120" "130" "140" "150" "160" "180" "200")))
  124. (setq pur_list '((dsc_list "BUSH" "CYLINDER" "LINEAR GUIDER" "BALL SCREW" "BEARING" "MOTOR" "SOCKET" "SPINDLE" "COUPLING" "SENSOR" "SHOCK ABSORB" "SPRING")
  125.                  (spl_list "MISUMI" "FESTO" "SEW" "BOSCH REXROTH" "APEX" "ATLAS" "SIEMENS" "SMC" "PARKER" "TOX" "SKF" "KTR" "BALLUFF" "ACE" "SEALTECH" "LEE")
  126.                  (FESTO "CYLINDER" "TERMINAL VALVE")
  127.                  (FESTO_CYLINDER "DNC #-#-PPV-A" "DNC #-#-PPV-A-KP" "ADN #-#-A-P-A")
  128.                  (SEW "MOTOR")
  129.                  (BOSCHREXROTH "LINEAR GUIDE" "RUNNER BLOCK" "BALL SCREW" "SPINDLE")
  130.                  (BOSCHREXROTH_LINEARGUIDE "REXROTH_R1605-113-31 L#" "REXROTH_R1605-713-31 L#" "REXROTH_R1605-713-31 L#")
  131.                  (BOSCHREXROTH_RUNNERBLOCK "REXROTH_R1622-113-20" "REXROTH_R1622-213-20" "REXROTH_R1622-713-20")
  132.                  (BOSCHREXROTH_BALLSCREW "FEM-E-C 16x5Rx3-4 1 0 T7 R41Z170 R81Z170 # 0 1" "FEM-E-C 25x5Rx3-4 1 0 T7 R41Z170 R81Z170 # 0 1" "FEM-E-C 32x5Rx3-4 1 0 T7 R41Z170 R81Z170 # 0 1")
  133.                  (APEX "SPINDLE" "SOCKET")
  134.                  (ATLAS "SPINDLE" "SOCKET")
  135.                  (SIEMENS "SERVO MORTOR")
  136.    (SIEMENS_SERVOMOTOR "1FK7034" "1FK7040" "1FK7060")
  137.                  (SMC "CYLINDER")
  138.                  (PARKER "CYLINDER")
  139.                  (TOX "CYLINDER")
  140.                  (SKF "BEARING")
  141.                  (KTR "COUPLING")
  142.                  (ACE "SHOCK ABSORBER")
  143.    (ACE_SHOCKABSORBER "MC150M" "MC225M" "MC600M")
  144.                  (BULLUFF "SENSOE")
  145.                  (SEALTECK "O SEALING RING")
  146.                  (LEE "SPRING")
  147.                  (MISUMI "BUSH")
  148.                  (MISUMI_BUSH "MPBZ#-#" "MBPZU1#-#")
  149.                  (rmk_list "PURCHASED")))


此时程序已可以实现第一幅图的功能。不过还是要“未完待续……”
回复 支持 反对

使用道具 举报

chpmould
发表于 2012-4-22 11:54:06 | 显示全部楼层
支持一个...
回复 支持 反对

使用道具 举报

fundoll
发表于 2012-4-22 16:34:14 | 显示全部楼层
希望版主早日完成,造福社友,谢谢!
回复 支持 反对

使用道具 举报

jicqj
发表于 2012-5-20 22:34:41 | 显示全部楼层
好复杂  没整明白  要慢慢消化  呵呵.谢谢 楼主分享
回复 支持 反对

使用道具 举报

123456下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-12-24 01:58 , Processed in 0.174159 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表