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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 应用篇 › AutoCAD基础应用 › lsp源码发在这里，增加点人气
123下一页
返回列表 发新帖
查看: 10381|回复: 27

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

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

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

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

  
ET

本帖子中包含更多资源

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

x

点评

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

评分

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

查看全部评分

相关帖子
回复

使用道具 举报

renyonghua2014
发表于 2019-6-16 19:11:42 | 显示全部楼层
严大师，TEXT非常完美，但对Mtext还是存在一定的问题
回复 支持 反对

使用道具 举报

slq803
发表于 2019-6-14 00:01:23 | 显示全部楼层
谢谢分享，留个脚印，以后学习
回复 支持 反对

使用道具 举报

xiaxiang
发表于 2012-1-6 17:04:59 | 显示全部楼层
我来顶你！这是一个好办法，在lisp版块做做广告，把源码发到这里来
继续发，我继续给你加分！！！！！！！！！！！！！！！！！！！！
回复 支持 反对

使用道具 举报

xiaxiang
发表于 2012-1-6 17:15:21 | 显示全部楼层
我也来发一个，压箱底的，连续拷贝程序，缺陷是不能响应"U"回退

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

点评

puzb2001
我当宝收藏了！非常感谢  发表于 2012-3-13 08:31
【KAIXIN】
这样也好 如果多弄点CAD的加强命令会更好！  发表于 2012-1-6 18:22
回复 支持 反对

使用道具 举报

【KAIXIN】
发表于 2012-1-6 18:25:14 | 显示全部楼层
继续
  2. ;2位小数坐标标注
  3. (defun c:KJ_ZB2()
  4.      (setvar "cmdecho" 0) ;指令执行过程不响应
  5.      (PRINC "\n【開金CAD外挂】---2位小数坐标标注功能")(PRINC)
  6.     (setq k (getvar "CLAYER"))
  7. (setq mkj (getvar 'OSMODE))        ;提取捕捉
  8.        (KX_dim);KAIXIN自定义标注参数通用函数
  9.      (setvar "OSMODE" 167)
  10.      (setvar "dimdec" 2)
  11. (while(setq a (getpoint "\n-->请指定标注点："))
  12. (command "_.DIMORDINATE" a pause ))
  13.      (setvar  "CLAYER" k)
  14. (setvar "osmode" mkj)
  15.      (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★     2位小数坐标标注完成！")(PRINC))

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

  35. ))
  36.      (setvar  "CLAYER" layer)  设标注层为当然层
  37. (princ))
回复 支持 反对

使用道具 举报

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






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





  68. ;新建标注样式
  69. (defun c:KJ_XB()
  70.      (setq a (getvar "osmode"));获取捕捉方式的值
  71.      (setvar "osmode" 0)
  72.      (setvar "cmdecho" 0) ;指令执行过程不响应
  73.   (command "style" "宋体" "宋体" "0" "1" "0" "" "")
  74.   (command"-dimstyle" "s" "KaiJin")
  75.   (command "dimtxt"   "2.5"         "dimasz"   "2"      "dimexe"
  76.            ".5"              "dimexo"         "0.5"            "dimgap"   "0.5"
  77.            "dimtoh"   "off"         "dimtih"   "off"      "blipmode"
  78.            "0"              "DIMDLI"         "5"            "DIMATFIT" "3"
  79.            "DIMTAD"   "0"         "DIMDEC"   "2"               "DIMTXSTY"
  80.            "宋体"   "DIMCLRT"         "6"            "DIMJUST"  "0"
  81.            "DIMDSEP"  "."         "DIMTOFL"  "0" "dimtmove" "0"
  82.            "dimcen" "0" "dimclrd" "3" "dimclre" "5"
  83.           )
  84.      (setvar "osmode" a);还原捕捉方式
  85. (princ)
  86.      (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建标注样式完成！")(PRINC))





  92. ;新建全部图层
  93. (defun c:KJ_XT ()
  94.   (setvar "cmdecho" 0)
  95.   (command "layer" "new" "中心线   center" "s" "中心线   center" "C" 1 "" "L" "Center" "" "LW" 0.09 "" "")
  96.   (command "layer" "new" "水路     cool" "s" "水路     cool" "C" 153 "" "L" "HIDDEN" "" "LW" 0.09 "" "")
  97.   (command "layer" "new" "模仁     core" "s" "模仁     core" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  98.   (command "layer" "new" "标注     dim" "s" "标注     dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
  99.   (command "layer" "new" "顶针     epin" "s" "顶针     epin" "C" 13 "" "L" "Continuous" "" "LW" 0.09 "" "")
  100.   (command "layer" "new" "表格     from" "s" "表格     from" "C" 7 "" "L" "Continuous" "" "LW" 0.13 "" "")
  101.   (command "layer" "new" "填充     hatch" "s" "填充     hatch" "C" 56 "" "L" "Continuous" "" "LW" 0.09 "" "")
  102.   (command "layer" "new" "镶件     insert" "s" "镶件     insert" "C" 85 "" "L" "Continuous" "" "LW" 0.2 "" "")
  103.   (command "layer" "new" "斜顶     lift" "s" "斜顶     lift" "C" 62 "" "L" "Continuous" "" "LW" 0.2 "" "")
  104.   (command "layer" "new" "模胚     moldbase" "s" "模胚     moldbase" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  105.   (command "layer" "new" "产品     part" "s" "产品     part" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  106.   (command "layer" "new" "流道     runner" "s" "流道     runner" "C" 141 "" "L" "Continuous" "" "LW" 0.13 "" "")
  107.   (command "layer" "new" "螺丝     screw " "s" "螺丝     screw" "C" 33 "" "L" "Continuous" "" "LW" 0.13 "" "")
  108.   (command "layer" "new" "滑块     slide" "s" "滑块     slide" "C" 42 "" "L" "Continuous" "" "LW" 0.2 "" "")
  109.   (command "layer" "new" "撑头     sp" "s" "撑头     sp" "C" 193 "" "L" "Continuous" "" "LW" 0.09 "" "")
  110.   (command "layer" "new" "弹簧     spring" "s" "弹簧     spring" "C" 132 "" "L" "Continuous" "" "LW" 0.09 "" "")
  111.   (command "layer" "new" "临时     temp" "s" "临时     temp" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
  112.   (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
  113.   (PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★      新建全部图层完成！")(PRINC))
回复 支持 反对

使用道具 举报

zbwei120
发表于 2012-1-7 23:15:47 | 显示全部楼层
东西不错，支持一下。不过如何挖掘cad的各种功能才是最主要的。
回复 支持 反对

使用道具 举报

tjuzkj
发表于 2012-1-10 08:10:22 | 显示全部楼层
不错，活跃气氛，赞一个！
回复 支持 反对

使用道具 举报

zyhandw
发表于 2012-1-14 10:15:04 | 显示全部楼层
顶！！！
让这个板块也火起来！
回复 支持 反对

使用道具 举报

haiyunzhou
发表于 2012-2-18 21:55:19 | 显示全部楼层
学习了 非常感谢
回复 支持 反对

使用道具 举报

江湖远人
发表于 2012-2-19 00:31:54 | 显示全部楼层
多谢楼主分享，收藏了，学习一下
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-23 11:49 , Processed in 0.189856 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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