明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 10334|回复: 27

lsp源码发在这里,增加点人气

    [复制链接]
发表于 2012-1-6 13:32:21 | 显示全部楼层 |阅读模式
自己写的lsp源码,发在这里,增加点人气,版主可以过一段时间再移走哈

  1. (defun c:tcl(/ sss ss1 ss2 s1 tsr lst_s1 lst2 n e p10 lste&p p1 t_e p2 p3
  2.   lst1_e e1 vla_e1 p4 dist1 lst_p1 lst_p2 lst_p3 lst_p4
  3.   pcenter xdist ydist px1 px2 py1 py2 mip1 map1 vla_t_e
  4.   center1 mindist)
  5.   (command "undo" "be")
  6.   (setvar "osmode" 0)
  7.   (setvar "cmdecho" 0)
  8.   (command "ucs" "w")
  9.   (setq  olderror *error*)
  10.   (setq *error* myerror)
  11.   (DEFUN myerror (msg)
  12.    (cond ((or( = lst_p1 nil)( = lst_p2 nil)( = lst_p3 nil)( = lst_p4 nil))
  13.        (alert "出错!所选有文字不在表格框内或表格有多段线!!")
  14.        (setq  *error* olderror )
  15.     )
  16.         
  17.          (t( /= msg "函数被取消")(princ "\n出错!程序已经退出!")(setq  *error* olderror ))
  18.       
  19.   )
  20.   (PRINC)
  21. )

  22.   ;;;;;;;;选择集转表
  23.   (defun ssget->list (ss / i ename )
  24.     (setq i -1)
  25.     (while (setq ename (ssname ss (setq i (1+ i))))
  26.       (setq lst2 (cons  ename lst2))
  27.     )
  28.     lst2
  29.   )
  30. (setq sss(ssget'((0 . "*TEXT"))))
  31.   (ssget->list sss)
  32. (setq lst_s1 lst2 lst2 nil)
  33.   

  

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

命令: APPLOAD 已成功加载 tcl.LSP。 命令: ; 错误: *error* 函数中出错AutoCAD 变量设置被拒绝: "cmdecho" nil 我用的cad2010,怎么出现这个东东啊  发表于 2013-1-26 21:58

评分

参与人数 3明经币 +3 金钱 +21 收起 理由
冰雪艳 + 6 很给力!
【KAIXIN】 + 1 + 15 很给力!
xiaxiang + 2 赞一个!

查看全部评分

发表于 2019-6-16 19:11:42 | 显示全部楼层
严大师,TEXT非常完美,但对Mtext还是存在一定的问题
发表于 2019-6-14 00:01:23 | 显示全部楼层
谢谢分享,留个脚印,以后学习
发表于 2012-1-6 17:04:59 | 显示全部楼层
我来顶你!这是一个好办法,在lisp版块做做广告,把源码发到这里来
继续发,我继续给你加分!!!!!!!!!!!!!!!!!!!!
发表于 2012-1-6 17:15:21 | 显示全部楼层
我也来发一个,压箱底的,连续拷贝程序,缺陷是不能响应"U"回退

  1. ;--------------------------------
  2. ;明经通道借来的程序
  3. ;-------------------------------
  4. ; Continuous Copy
  5. ;-------------------------------
  6. (defun c:Cc ()
  7. ;**** 内部错误处理 ****
  8. (defun DR_ERR (S) ; 如果一个错误发生,如CTRL-C
  9. (if (/= S "Function cancelled") ;当这个命令被激活
  10. (if (= S "quit / exit abort")
  11. (princ)
  12. (princ (strcat "\nError: " S))
  13. );end if
  14. );end if
  15. (if DR_OER ;如果一个旧的错误存在
  16. (setq *error* DR_OER) ;就重置
  17. );end if
  18. (if (not BASEPT) ;如果在复制初始使用了位移选项
  19. (foreach x SSELIST (redraw X 4));把最后的选择集去除高亮
  20. )
  21. (setvar "cmdecho" 1) ;重置发生错误的命令响应
  22. (princ)
  23. );end error defun
  24. ;**** 设置新的错误处理****
  25. (if (not *DEBUG*)
  26. (if *error*
  27. (setq DR_OER *error* *error* DR_ERR)
  28. (setq *error* DR_ERR)
  29. );end if
  30. );end if
  31. ;****主程序****
  32. (if (setq EMARK (entlast))
  33. (while (setq B (entnext EMARK))
  34. (setq EMARK B)
  35. )
  36. )
  37. (setq SS (ssget))
  38. (setvar "cmdecho" 0)
  39. (prompt "\n指定基点或 [位移(D)] <位移>:")
  40. (command "copy" SS "" pause)
  41. (setq BASEPT (getvar "lastpoint"))
  42. (prompt "\n拷贝的基点")
  43. (command pause)
  44. (if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
  45. (progn (setq REFPT LASTPT)
  46. (setq BASEPT nil)
  47. )
  48. )
  49. (if BASEPT
  50. (while (entnext EMARK) ;当有新的实体产生
  51. (setq SSOLD SS)
  52. (setq SS (ssadd)) ;重置选择集
  53. (while (entnext EMARK) ;当有新的实体产生
  54. (setq EMARK (entnext EMARK))
  55. (ssadd EMARK SS) ;加到新的选择集
  56. )
  57. (if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
  58. (progn (command "erase" SS "")
  59. (command "copy" SSOLD "" REFPT "")
  60. (setvar "lastpoint" (polar BASEPT ANGLPT DISTPT))
  61. )
  62. (progn (setq ANGLPT (angle BASEPT LASTPT))
  63. (setq DISTPT (distance BASEPT LASTPT))
  64. (setq REFPT (polar '(0.0 0.0 0.0) ANGLPT DISTPT))
  65. (setq BASEPT LASTPT) ;递增基点
  66. (prompt (strcat "\n重新指定拷贝的基点;本次相对距离为<@" (rtos (car REFPT))
  67. "," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: "))
  68. (command "copy" SS "" BASEPT pause)
  69. )
  70. )
  71. );end while
  72. (while (entnext EMARK) ;当有新的实体产生
  73. (setq SSOLD SS)
  74. (setq SS (ssadd)) ;重置选择集
  75. (while (entnext EMARK) ;当有新的实体产生
  76. new entities
  77. (setq EMARK (entnext EMARK))
  78. (redraw EMARK 3)
  79. (if SSELIST
  80. (setq SSELIST (append (list EMARK) SSELIST))
  81. (setq SSELIST (list EMARK))
  82. )
  83. (ssadd EMARK SS) ;加到新的选择集
  84. )
  85. (ssget "P")
  86. (setq REFPT (getpoint (strcat "\n位移(D)<" (rtos (car
  87. REFPT)) "," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: ")))
  88. (if (not REFPT)
  89. (setq REFPT (getvar "lastpoint"))
  90. )
  91. (command "copy" SS "" REFPT "")
  92. );end while
  93. );end if
  94. (setvar "cmdecho" 1)
  95. (princ)
  96. );end defun
  97. (princ)
  98. (princ "\n ******* 连续拷贝程序已加载。命令: CC ************\n")
  99. (princ)

点评

我当宝收藏了!非常感谢  发表于 2012-3-13 08:31
这样也好 如果多弄点CAD的加强命令会更好!  发表于 2012-1-6 18:22
发表于 2012-1-6 18:25:14 | 显示全部楼层
继续
  1. ;2位小数坐标标注
  2. (defun c:KJ_ZB2()
  3.      (setvar "cmdecho" 0) ;指令执行过程不响应
  4.      (PRINC "\n【開金CAD外挂】---2位小数坐标标注功能")(PRINC)
  5.     (setq k (getvar "CLAYER"))
  6. (setq mkj (getvar 'OSMODE))        ;提取捕捉
  7.        (KX_dim);KAIXIN自定义标注参数通用函数
  8.      (setvar "OSMODE" 167)
  9.      (setvar "dimdec" 2)
  10. (while(setq a (getpoint "\n-->请指定标注点:"))
  11. (command "_.DIMORDINATE" a pause ))
  12.      (setvar  "CLAYER" k)
  13. (setvar "osmode" mkj)
  14.      (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★     2位小数坐标标注完成!")(PRINC))

  15. (defun KX_dim ()
  16. (command "style" "宋体" "宋体" "0" "1" "0" "" "")
  17.   (command "dimtxt"   "2.5"         "dimasz"   "2"    ; 文字高度:2.5,箭头大小:2
  18.            "dimexe"  "0.5"       "dimexo"   "0.5"    ;尺寸界限超出长度:0.5,尺寸界限起点距离:0.5  
  19.            "dimgap"   "0.5"     "dimtoh"   "off"    ;标注文字周围的距离:0.5,文字在尺寸界线外的位置:关          
  20.            "dimtih"   "OFF"     "blipmode"  "0"    ; 标注文字在尺寸界线内的位置:关,点标记模式:关             
  21.            "DIMDLI"  "5"        "DIMATFIT"  "3"    ; 控制基线标注中尺寸线的间距:5,当尺寸界线不足放下标注文字和箭头时,函数DIMATFIT确定位置
  22.            "DIMTAD"   "0"         "DIMDEC"   "2"    ;控制文字相对尺寸线的垂直位置,小数位数:2              
  23.            "DIMTXSTY"  "宋体"   "DIMCLRT"   "6"    ;指定标注的文字样式:宋体,为标注文字指定颜色:6           
  24.            "DIMJUST"  "0"       "DIMDSEP"  "."    ; 控制标注文字的水平位置:0,小数分隔符为 .         
  25.            "DIMTOFL"  "0"        "dimtmove" "0"    ;控制标注文字在尺寸界线外的位置:关对齐,设置标注文字的移动规则:0 水平
  26.            "dimcen" "0"         "dimclrd" "3"     ;标注圆心:不标,为尺寸线、箭头和标注引线指定颜色:3
  27.            "dimclre" "5"     ;    ;为尺寸界线指定颜色  
  28.           )
  29. (setq layer "标注     dim")(if (not (tblsearch "layer" layer ))
  30. ;设图层 判断是否有图层,如果没有建图层
  31.   (progn (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")

  32. ))
  33.      (setvar  "CLAYER" layer)  设标注层为当然层
  34. (princ))
发表于 2012-1-6 18:27:09 | 显示全部楼层
  1. ;-----------------------------------------------------------------------------------------------------------------------
  2. ;--------------------------------◆●【新建文字样式/标注样式/图层】●◆------------------------------------------------
  3. ;-----------------------------------------------------------------------------------------------------------------------
  4. ;新建全部
  5. (defun c:KJ_XQB()
  6.      (setq a (getvar "osmode"));获取捕捉方式的值
  7.      (setvar "osmode" 0)
  8.      (setvar "cmdecho" 0) ;指令执行过程不响应
  9.   (command "style" "宋体" "宋体" "0" "1" "0" "" "")
  10.   (command "style" "幼圆" "幼圆" "0" "1" "0" "" "")
  11.   (command "style" "新宋体" "新宋体" "0" "1" "0" "" "")
  12.   (command "style" "楷体_GB2312" "楷体_GB2312" "0" "1" "0" "" "")
  13.   (command "style" "TXT" "txt.shx" "0" "1" "0" "" ""  "")
  14. (command"-dimstyle" "s" "KaiJin")
  15.   (command "dimtxt"   "2.5"         "dimasz"   "2"      "dimexe"
  16.            ".5"              "dimexo"         "0.5"            "dimgap"   "0.5"
  17.            "dimtoh"   "off"         "dimtih"   "off"      "blipmode"
  18.            "0"              "DIMDLI"         "5"            "DIMATFIT" "1"
  19.            "DIMTAD"   "0"         "DIMDEC"   "2"               "DIMTXSTY"
  20.            "宋体"   "DIMCLRT"         "6"            "DIMJUST"  "0"
  21.            "DIMDSEP"  "."         "DIMTOFL"  "0" "dimtmove" "0"
  22.            "dimcen" "0" "dimclrd" "3" "dimclre" "5"
  23.           )
  24.   (command "layer" "new" "中心线   center" "s" "中心线   center" "C" 1 "" "L" "Center" "" "LW" 0.09 "" "")
  25.   (command "layer" "new" "水路     cool" "s" "水路     cool" "C" 153 "" "L" "HIDDEN" "" "LW" 0.09 "" "")
  26.   (command "layer" "new" "模仁     core" "s" "模仁     core" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  27.   (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
  28.   (command "layer" "new" "顶针     epin" "s" "顶针     epin" "C" 13 "" "L" "Continuous" "" "LW" 0.09 "" "")
  29.   (command "layer" "new" "表格     from" "s" "表格     from" "C" 7 "" "L" "Continuous" "" "LW" 0.13 "" "")
  30.   (command "layer" "new" "填充     hatch" "s" "填充     hatch" "C" 56 "" "L" "Continuous" "" "LW" 0.09 "" "")
  31.   (command "layer" "new" "镶件     insert" "s" "镶件     insert" "C" 85 "" "L" "Continuous" "" "LW" 0.2 "" "")
  32.   (command "layer" "new" "斜顶     lift" "s" "斜顶     lift" "C" 62 "" "L" "Continuous" "" "LW" 0.2 "" "")
  33.   (command "layer" "new" "模胚     moldbase" "s" "模胚     moldbase" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  34.   (command "layer" "new" "产品     part" "s" "产品     part" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  35.   (command "layer" "new" "流道     runner" "s" "流道     runner" "C" 141 "" "L" "Continuous" "" "LW" 0.13 "" "")
  36.   (command "layer" "new" "螺丝     screw " "s" "螺丝     screw" "C" 33 "" "L" "Continuous" "" "LW" 0.13 "" "")
  37.   (command "layer" "new" "滑块     slide" "s" "滑块     slide" "C" 42 "" "L" "Continuous" "" "LW" 0.2 "" "")
  38.   (command "layer" "new" "撑头     sp" "s" "撑头     sp" "C" 193 "" "L" "Continuous" "" "LW" 0.09 "" "")
  39.   (command "layer" "new" "弹簧     spring" "s" "弹簧     spring" "C" 132 "" "L" "Continuous" "" "LW" 0.09 "" "")
  40.   (command "layer" "new" "临时     temp" "s" "临时     temp" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  41.   (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
  42.    (setvar "osmode" a);还原捕捉方式
  43.   (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建图层,标注、文字样式完成!")(PRINC))






  44. ;新建文字样式
  45. (defun c:KJ_XW()
  46.      (setq a (getvar "osmode"));获取捕捉方式的值
  47.      (setvar "osmode" 0)
  48.      (setvar "cmdecho" 0) ;指令执行过程不响应
  49.   (command "style" "宋体" "宋体" "0" "1" "0" "" "")
  50.   (command "style" "幼圆" "幼圆" "0" "1" "0" "" "")
  51.   (command "style" "新宋体" "新宋体" "0" "1" "0" "" "")
  52.   (command "style" "楷体_GB2312" "楷体_GB2312" "0" "1" "0" "" "")
  53.   (command "style" "TXT" "txt.shx" "0" "1" "0" "" ""  "")
  54.      (setvar "osmode" a);还原捕捉方式
  55.      (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建文字样式完成!")(PRINC))





  56. ;新建标注样式
  57. (defun c:KJ_XB()
  58.      (setq a (getvar "osmode"));获取捕捉方式的值
  59.      (setvar "osmode" 0)
  60.      (setvar "cmdecho" 0) ;指令执行过程不响应
  61.   (command "style" "宋体" "宋体" "0" "1" "0" "" "")
  62.   (command"-dimstyle" "s" "KaiJin")
  63.   (command "dimtxt"   "2.5"         "dimasz"   "2"      "dimexe"
  64.            ".5"              "dimexo"         "0.5"            "dimgap"   "0.5"
  65.            "dimtoh"   "off"         "dimtih"   "off"      "blipmode"
  66.            "0"              "DIMDLI"         "5"            "DIMATFIT" "3"
  67.            "DIMTAD"   "0"         "DIMDEC"   "2"               "DIMTXSTY"
  68.            "宋体"   "DIMCLRT"         "6"            "DIMJUST"  "0"
  69.            "DIMDSEP"  "."         "DIMTOFL"  "0" "dimtmove" "0"
  70.            "dimcen" "0" "dimclrd" "3" "dimclre" "5"
  71.           )
  72.      (setvar "osmode" a);还原捕捉方式
  73. (princ)
  74.      (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建标注样式完成!")(PRINC))





  75. ;新建全部图层
  76. (defun c:KJ_XT ()
  77.   (setvar "cmdecho" 0)
  78.   (command "layer" "new" "中心线   center" "s" "中心线   center" "C" 1 "" "L" "Center" "" "LW" 0.09 "" "")
  79.   (command "layer" "new" "水路     cool" "s" "水路     cool" "C" 153 "" "L" "HIDDEN" "" "LW" 0.09 "" "")
  80.   (command "layer" "new" "模仁     core" "s" "模仁     core" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  81.   (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
  82.   (command "layer" "new" "顶针     epin" "s" "顶针     epin" "C" 13 "" "L" "Continuous" "" "LW" 0.09 "" "")
  83.   (command "layer" "new" "表格     from" "s" "表格     from" "C" 7 "" "L" "Continuous" "" "LW" 0.13 "" "")
  84.   (command "layer" "new" "填充     hatch" "s" "填充     hatch" "C" 56 "" "L" "Continuous" "" "LW" 0.09 "" "")
  85.   (command "layer" "new" "镶件     insert" "s" "镶件     insert" "C" 85 "" "L" "Continuous" "" "LW" 0.2 "" "")
  86.   (command "layer" "new" "斜顶     lift" "s" "斜顶     lift" "C" 62 "" "L" "Continuous" "" "LW" 0.2 "" "")
  87.   (command "layer" "new" "模胚     moldbase" "s" "模胚     moldbase" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  88.   (command "layer" "new" "产品     part" "s" "产品     part" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  89.   (command "layer" "new" "流道     runner" "s" "流道     runner" "C" 141 "" "L" "Continuous" "" "LW" 0.13 "" "")
  90.   (command "layer" "new" "螺丝     screw " "s" "螺丝     screw" "C" 33 "" "L" "Continuous" "" "LW" 0.13 "" "")
  91.   (command "layer" "new" "滑块     slide" "s" "滑块     slide" "C" 42 "" "L" "Continuous" "" "LW" 0.2 "" "")
  92.   (command "layer" "new" "撑头     sp" "s" "撑头     sp" "C" 193 "" "L" "Continuous" "" "LW" 0.09 "" "")
  93.   (command "layer" "new" "弹簧     spring" "s" "弹簧     spring" "C" 132 "" "L" "Continuous" "" "LW" 0.09 "" "")
  94.   (command "layer" "new" "临时     temp" "s" "临时     temp" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  95.   (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
  96.   (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建全部图层完成!")(PRINC))
发表于 2012-1-7 23:15:47 | 显示全部楼层
东西不错,支持一下。不过如何挖掘cad的各种功能才是最主要的。
发表于 2012-1-10 08:10:22 | 显示全部楼层
不错,活跃气氛,赞一个!
发表于 2012-1-14 10:15:04 | 显示全部楼层
顶!!!
让这个板块也火起来!
发表于 2012-2-18 21:55:19 | 显示全部楼层
学习了 非常感谢
发表于 2012-2-19 00:31:54 | 显示全部楼层
多谢楼主分享,收藏了,学习一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-15 01:39 , Processed in 0.484969 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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