lsp源码发在这里，增加点人气
自己写的lsp源码，发在这里，增加点人气，版主可以过一段时间再移走哈(defun c:tcl(/ sss ss1 ss2 s1 tsr lst_s1 lst2 n e p10 lste&p p1 t_e p2 p3
lst1_e e1 vla_e1 p4 dist1 lst_p1 lst_p2 lst_p3 lst_p4
pcenter xdist ydist px1 px2 py1 py2 mip1 map1 vla_t_e
center1 mindist)
(command "undo" "be")
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(command "ucs" "w")
(setqolderror *error*)
(setq *error* myerror)
(DEFUN myerror (msg)
(cond ((or( = lst_p1 nil)( = lst_p2 nil)( = lst_p3 nil)( = lst_p4 nil))
(alert "出错!所选有文字不在表格框内或表格有多段线!!")
(setq*error* olderror )
)
(t( /= msg "函数被取消")(princ "\n出错!程序已经退出!")(setq*error* olderror ))
)
(PRINC)
)
;;;;;;;;选择集转表
(defun ssget->list (ss / i ename )
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq lst2 (consename lst2))
)
lst2
)
(setq sss(ssget'((0 . "*TEXT"))))
(ssget->list sss)
(setq lst_s1 lst2 lst2 nil)
严大师，TEXT非常完美，但对Mtext还是存在一定的问题 谢谢分享，留个脚印，以后学习 我来顶你！这是一个好办法，在lisp版块做做广告，把源码发到这里来
继续发，我继续给你加分！！！！！！！！！！！！！！！！！！！！ 我也来发一个，压箱底的，连续拷贝程序，缺陷是不能响应"U"回退
;--------------------------------
;明经通道借来的程序
;-------------------------------
; Continuous Copy
;-------------------------------
(defun c:Cc ()
;**** 内部错误处理 ****
(defun DR_ERR (S) ; 如果一个错误发生，如CTRL-C
(if (/= S "Function cancelled") ;当这个命令被激活
(if (= S "quit / exit abort")
(princ)
(princ (strcat "\nError: " S))
);end if
);end if
(if DR_OER ;如果一个旧的错误存在
(setq *error* DR_OER) ;就重置
);end if
(if (not BASEPT) ;如果在复制初始使用了位移选项
(foreach x SSELIST (redraw X 4));把最后的选择集去除高亮
)
(setvar "cmdecho" 1) ;重置发生错误的命令响应
(princ)
);end error defun
;**** 设置新的错误处理****
(if (not *DEBUG*)
(if *error*
(setq DR_OER *error* *error* DR_ERR)
(setq *error* DR_ERR)
);end if
);end if
;****主程序****
(if (setq EMARK (entlast))
(while (setq B (entnext EMARK))
(setq EMARK B)
)
)
(setq SS (ssget))
(setvar "cmdecho" 0)
(prompt "\n指定基点或 [位移(D)] <位移>:")
(command "copy" SS "" pause)
(setq BASEPT (getvar "lastpoint"))
(prompt "\n拷贝的基点")
(command pause)
(if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
(progn (setq REFPT LASTPT)
(setq BASEPT nil)
)
)
(if BASEPT
(while (entnext EMARK) ;当有新的实体产生
(setq SSOLD SS)
(setq SS (ssadd)) ;重置选择集
(while (entnext EMARK) ;当有新的实体产生
(setq EMARK (entnext EMARK))
(ssadd EMARK SS) ;加到新的选择集
)
(if (equal BASEPT (setq LASTPT (getvar "lastpoint")))
(progn (command "erase" SS "")
(command "copy" SSOLD "" REFPT "")
(setvar "lastpoint" (polar BASEPT ANGLPT DISTPT))
)
(progn (setq ANGLPT (angle BASEPT LASTPT))
(setq DISTPT (distance BASEPT LASTPT))
(setq REFPT (polar '(0.0 0.0 0.0) ANGLPT DISTPT))
(setq BASEPT LASTPT) ;递增基点
(prompt (strcat "\n重新指定拷贝的基点;本次相对距离为<@" (rtos (car REFPT))
"," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: "))
(command "copy" SS "" BASEPT pause)
)
)
);end while
(while (entnext EMARK) ;当有新的实体产生
(setq SSOLD SS)
(setq SS (ssadd)) ;重置选择集
(while (entnext EMARK) ;当有新的实体产生
new entities
(setq EMARK (entnext EMARK))
(redraw EMARK 3)
(if SSELIST
(setq SSELIST (append (list EMARK) SSELIST))
(setq SSELIST (list EMARK))
)
(ssadd EMARK SS) ;加到新的选择集
)
(ssget "P")
(setq REFPT (getpoint (strcat "\n位移(D)<" (rtos (car
REFPT)) "," (rtos (cadr REFPT)) "," (rtos (caddr REFPT))">: ")))
(if (not REFPT)
(setq REFPT (getvar "lastpoint"))
)
(command "copy" SS "" REFPT "")
);end while
);end if
(setvar "cmdecho" 1)
(princ)
);end defun
(princ)
(princ "\n ******* 连续拷贝程序已加载。命令: CC ************\n")
(princ)
继续;2位小数坐标标注
(defun c:KJ_ZB2()
(setvar "cmdecho" 0) ;指令执行过程不响应
(PRINC "\n【開金CAD外挂】---2位小数坐标标注功能")(PRINC)
(setq k (getvar "CLAYER"))
(setq mkj (getvar 'OSMODE)) ;提取捕捉
(KX_dim);KAIXIN自定义标注参数通用函数
(setvar "OSMODE" 167)
(setvar "dimdec" 2)
(while(setq a (getpoint "\n-->请指定标注点："))
(command "_.DIMORDINATE" a pause ))
(setvar"CLAYER" k)
(setvar "osmode" mkj)
(PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★ 2位小数坐标标注完成！")(PRINC))
(defun KX_dim ()
(command "style" "宋体" "宋体" "0" "1" "0" "" "")
(command "dimtxt" "2.5" "dimasz" "2" ; 文字高度：2.5，箭头大小：2
"dimexe""0.5" "dimexo" "0.5" ;尺寸界限超出长度：0.5，尺寸界限起点距离：0.5
"dimgap" "0.5" "dimtoh" "off" ;标注文字周围的距离：0.5，文字在尺寸界线外的位置：关
"dimtih" "OFF" "blipmode""0" ; 标注文字在尺寸界线内的位置：关，点标记模式：关
"DIMDLI""5" "DIMATFIT""3" ; 控制基线标注中尺寸线的间距：5，当尺寸界线不足放下标注文字和箭头时，函数DIMATFIT确定位置
"DIMTAD" "0" "DIMDEC" "2" ;控制文字相对尺寸线的垂直位置，小数位数：2
"DIMTXSTY""宋体" "DIMCLRT" "6" ;指定标注的文字样式：宋体，为标注文字指定颜色：6
"DIMJUST""0" "DIMDSEP""." ; 控制标注文字的水平位置：0，小数分隔符为 .
"DIMTOFL""0" "dimtmove" "0" ;控制标注文字在尺寸界线外的位置：关对齐，设置标注文字的移动规则：0 水平
"dimcen" "0" "dimclrd" "3" ;标注圆心：不标，为尺寸线、箭头和标注引线指定颜色：3
"dimclre" "5" ; ;为尺寸界线指定颜色
)
(setq layer "标注 dim")(if (not (tblsearch "layer" layer ))
;设图层 判断是否有图层，如果没有建图层
(progn (command "layer" "new" "标注 dim" "s" "标注 dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
))
(setvar"CLAYER" layer)设标注层为当然层
(princ))
;-----------------------------------------------------------------------------------------------------------------------
;--------------------------------◆●【新建文字样式/标注样式/图层】●◆------------------------------------------------
;-----------------------------------------------------------------------------------------------------------------------
;新建全部
(defun c:KJ_XQB()
(setq a (getvar "osmode"));获取捕捉方式的值
(setvar "osmode" 0)
(setvar "cmdecho" 0) ;指令执行过程不响应
(command "style" "宋体" "宋体" "0" "1" "0" "" "")
(command "style" "幼圆" "幼圆" "0" "1" "0" "" "")
(command "style" "新宋体" "新宋体" "0" "1" "0" "" "")
(command "style" "楷体_GB2312" "楷体_GB2312" "0" "1" "0" "" "")
(command "style" "TXT" "txt.shx" "0" "1" "0" "" """")
(command"-dimstyle" "s" "KaiJin")
(command "dimtxt" "2.5" "dimasz" "2" "dimexe"
".5" "dimexo" "0.5" "dimgap" "0.5"
"dimtoh" "off" "dimtih" "off" "blipmode"
"0" "DIMDLI" "5" "DIMATFIT" "1"
"DIMTAD" "0" "DIMDEC" "2" "DIMTXSTY"
"宋体" "DIMCLRT" "6" "DIMJUST""0"
"DIMDSEP""." "DIMTOFL""0" "dimtmove" "0"
"dimcen" "0" "dimclrd" "3" "dimclre" "5"
)
(command "layer" "new" "中心线 center" "s" "中心线 center" "C" 1 "" "L" "Center" "" "LW" 0.09 "" "")
(command "layer" "new" "水路 cool" "s" "水路 cool" "C" 153 "" "L" "HIDDEN" "" "LW" 0.09 "" "")
(command "layer" "new" "模仁 core" "s" "模仁 core" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "标注 dim" "s" "标注 dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "顶针 epin" "s" "顶针 epin" "C" 13 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "表格 from" "s" "表格 from" "C" 7 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "填充 hatch" "s" "填充 hatch" "C" 56 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "镶件 insert" "s" "镶件 insert" "C" 85 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "斜顶 lift" "s" "斜顶 lift" "C" 62 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "模胚 moldbase" "s" "模胚 moldbase" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "产品 part" "s" "产品 part" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "流道 runner" "s" "流道 runner" "C" 141 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "螺丝 screw " "s" "螺丝 screw" "C" 33 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "滑块 slide" "s" "滑块 slide" "C" 42 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "撑头 sp" "s" "撑头 sp" "C" 193 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "弹簧 spring" "s" "弹簧 spring" "C" 132 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "临时 temp" "s" "临时 temp" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "文字 text" "s" "文字 text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
(setvar "osmode" a);还原捕捉方式
(PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★ 新建图层，标注、文字样式完成！")(PRINC))
;新建文字样式
(defun c:KJ_XW()
(setq a (getvar "osmode"));获取捕捉方式的值
(setvar "osmode" 0)
(setvar "cmdecho" 0) ;指令执行过程不响应
(command "style" "宋体" "宋体" "0" "1" "0" "" "")
(command "style" "幼圆" "幼圆" "0" "1" "0" "" "")
(command "style" "新宋体" "新宋体" "0" "1" "0" "" "")
(command "style" "楷体_GB2312" "楷体_GB2312" "0" "1" "0" "" "")
(command "style" "TXT" "txt.shx" "0" "1" "0" "" """")
(setvar "osmode" a);还原捕捉方式
(PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★ 新建文字样式完成！")(PRINC))
;新建标注样式
(defun c:KJ_XB()
(setq a (getvar "osmode"));获取捕捉方式的值
(setvar "osmode" 0)
(setvar "cmdecho" 0) ;指令执行过程不响应
(command "style" "宋体" "宋体" "0" "1" "0" "" "")
(command"-dimstyle" "s" "KaiJin")
(command "dimtxt" "2.5" "dimasz" "2" "dimexe"
".5" "dimexo" "0.5" "dimgap" "0.5"
"dimtoh" "off" "dimtih" "off" "blipmode"
"0" "DIMDLI" "5" "DIMATFIT" "3"
"DIMTAD" "0" "DIMDEC" "2" "DIMTXSTY"
"宋体" "DIMCLRT" "6" "DIMJUST""0"
"DIMDSEP""." "DIMTOFL""0" "dimtmove" "0"
"dimcen" "0" "dimclrd" "3" "dimclre" "5"
)
(setvar "osmode" a);还原捕捉方式
(princ)
(PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★ 新建标注样式完成！")(PRINC))
;新建全部图层
(defun c:KJ_XT ()
(setvar "cmdecho" 0)
(command "layer" "new" "中心线 center" "s" "中心线 center" "C" 1 "" "L" "Center" "" "LW" 0.09 "" "")
(command "layer" "new" "水路 cool" "s" "水路 cool" "C" 153 "" "L" "HIDDEN" "" "LW" 0.09 "" "")
(command "layer" "new" "模仁 core" "s" "模仁 core" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "标注 dim" "s" "标注 dim" "C" 82 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "顶针 epin" "s" "顶针 epin" "C" 13 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "表格 from" "s" "表格 from" "C" 7 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "填充 hatch" "s" "填充 hatch" "C" 56 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "镶件 insert" "s" "镶件 insert" "C" 85 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "斜顶 lift" "s" "斜顶 lift" "C" 62 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "模胚 moldbase" "s" "模胚 moldbase" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "产品 part" "s" "产品 part" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "流道 runner" "s" "流道 runner" "C" 141 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "螺丝 screw " "s" "螺丝 screw" "C" 33 "" "L" "Continuous" "" "LW" 0.13 "" "")
(command "layer" "new" "滑块 slide" "s" "滑块 slide" "C" 42 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "撑头 sp" "s" "撑头 sp" "C" 193 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "弹簧 spring" "s" "弹簧 spring" "C" 132 "" "L" "Continuous" "" "LW" 0.09 "" "")
(command "layer" "new" "临时 temp" "s" "临时 temp" "C" 7 "" "L" "Continuous" "" "LW" 0.2 "" "")
(command "layer" "new" "文字 text" "s" "文字 text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
(PRINC "\n★★★欢迎使用--《開金CAD外挂》--★★★ 新建全部图层完成！")(PRINC)) 东西不错，支持一下。不过如何挖掘cad的各种功能才是最主要的。 不错，活跃气氛，赞一个！ 顶！！！
让这个板块也火起来！ 学习了 非常感谢 多谢楼主分享，收藏了，学习一下