新做的一个工具箱，请大虾指点一下！

uvyx

先说明一下，本人对LSP不是很懂，有时只是根据工作需要上网找找现成的，再简单修一修（也就是说偷人家的[em0]）！
复杂一般我看不懂，所以请多多包涵！！！
下面的程序也是修修补补完成的，也不知道合不合理，很多发生错误了的提示也不知道怎么判断，
请大虾们指正一下，谢谢！！
;;;*******************************************************************
;;;*** 修改工具
;;;*******************************************************************
;;;-------------------------------------------------------------------
;;; 将所选线转变成多段线
(defun PAi-Line2ChPline1 (/ ssa ssa-ent ent-p i)
    (setvar "cmdecho" 0)    ;关闭回显提示和输入
    (princ "\n将所选直线变成闭合多段线功能")
    (princ "\n请选取要转变成多段线的线：")
    (setq ent (ssget '((0 . "line,arc,*POLYLINE"))))
    (setq i 0)
    (setq ii 0)
    (while (< i (sslength ent))
      (setq ent-n (ssname ent i))  ;;获取图元名
      (setq ent-p (cdr(assoc 0 (entget ent-n))))  ;;获取图元类型名
      (if (or (= ent-p "LINE") (= ent-p "ARC")) (setq ii 1))
      (setq i (1+ i))
    )
    (cond
      ((= ii 0) (vl-cmdf "pedit" "m" ent "" "j" "0" ""))
      ((= ii 1) (vl-cmdf "pedit" "m" ent "" "Y" "j" "0" ""))
      (t (princ "\n操作有误，退出！") (exit))
    )
    (princ "\n将所选线转变成多段线完成！")
    (princ)
)
;;;-------------------------------------------------------------------

;;;*******************************************************************
;;;*** 绘图工具
;;;*******************************************************************
;;;-------------------------------------------------------------------
;;; 已知半径弧长画弧
(defun PAi-Arc2CrAtLengthRad1 ( / cen pt1 r lenth ang )
  (princ "\n画弧—已知半径弧长：")
  (setq pt1 (getpoint "\n请输入圆弧插入点："))
  (setq r (getreal "\n请输入圆半径："))
  (setq lenth (getreal "\n请输入弧长："))
  (setq cen (list (car pt1) (- (cadr pt1) r) (caddr pt1)))
  (setq ang (* 180 (/ lenth r pi)))
  (command "arc""c"cen pt1 "a" ang)
  (command "ROTATE" "L" "" cen (- 0 (/ ang 2)))
)
;;;-------------------------------------------------------------------
;;;*******************************************************************
;;;*** 块类工具
;;;*******************************************************************
;;; 插入图框1:自定义(图框必须在CAD支持的目录下)
(defun PAi-Bl2InFrameXSc1 ()
   (setvar "cmdecho" 0)
   (setq sc1 (getReal "\n插入图框，请输入图框统一比例 <10>:"))
   (if (= sc1 nil) (setq sc1 (atof "10")))
   (setq pt1 (getpoint "\n请点取插入点:"))
   (command "insert"  "图框-KYA3.dwg" pt1 "x" sc1 "" "" "" )
   (princ (strcat "\n插入图框完成，当前图框比例为：" (rtos sc1)))
   (princ)
)
;;;-------------------------------------------------------------------
;;;*******************************************************************
;;;*** 初始工具
;;;*******************************************************************
;;;-------------------------------------------------------------------
;;; 新建图层：名称layName1、颜色layColor1、线型layLineType1、线宽layLineWidth1、是否打印layPrint1
(defun PAi-CrNewLay1 (layName1 layColor1 layLineType1 layLineWidth1 layPrint1)
    (setvar "cmdecho" 0)    ;关闭回显提示和输入
    (if (= (tblsearch "layer" layName1) nil)
        (progn
            (vl-cmdf "layer" "N" layName1 "C" layColor1 layName1 "L" layLineType1 layName1 "LW" layLineWidth1 layName1 "" layPrint1 layName1 "")
            (princ (strcat "\n图层：" layName1 " 创建成功！"))
        ) (princ (strcat "\n图层：" layName1 " 已存在！"))
    ) (princ)
)
;;;-------------------------------------------------------------------
;;; 新建文字样式：文字样式名称txtName1、字体txtFont1、字体txtBigFont1、系统字体高度txtSysHeight1、宽度因子txtWidthFactor1
(defun PAi-CrNewTextStyle1 (txtName1 txtFont1 txtBigFont1 txtSysHeight1 txtWidthFactor1)
    (setvar "cmdecho" 0)    ;关闭回显提示和输入
    (if (= (tblsearch "STYLE" txtName1) nil)
        (progn
            (entmake (list
                '(0 . "STYLE")
                '(100 . "AcDbSymbolTableRecord")
                '(100 . "AcDbTextStyleTableRecord")
                (cons 2  txtName1)  
                '(70 . 0)
                '(40 . 0)   
                (cons 41 (atof txtWidthFactor1))  
                '(50 . 0.0)
                '(71 . 0)
                (cons 42  (atof txtSysHeight1))  
                (cons 3  txtFont1)      
                (cons 4  txtBigFont1)
                )
            ) (princ (strcat "\n文字样式：" txtName1 " 创建成功！"))
        ) (princ (strcat "\n文字样式：" txtName1 " 已存在！"))
    ) (princ)
)
;;;-------------------------------------------------------------------
;;; 新建标注样式：文字样式名称txtName1、标注样式名称dimName1、标注高度dimHeight1、全局比例dimScale1
(defun PAi-CrNewDimStyle1 (txtName1 dimName1 dimHeight1 dimScale1)
    (setvar "cmdecho" 0)    ;关闭回显提示和输入
    (if (= (tblsearch "DIMSTYLE" dimName1) nil)
        (progn
            (if (= (tblsearch "STYLE" txtName1) nil) (princ "\n错误：文本样式不存在！\n"))
            (setvar "DIMCLRD" 8)                 ;尺寸线颜色，对于“随块”，输入 0。 对于“随层”，输入 256
            (setvar "dimdle" 0.35)               ;超出标记
            (setvar "DIMDLI" 0.625)              ;基线间距
            (setvar "dimclre" 8)                 ;尺寸界线色
            (setvar "DIMEXE" 0.625)              ;超出尺寸线
            (setvar "DIMEXO" 1.5)                ;起点偏移量
            (setvar "DIMBLK" "_ARCHTICK")        ;箭头块名
            (setvar "DIMBLK1" "_ARCHTICK")       ;第一个箭头块名 建筑标记
            (setvar "DIMBLK2" "_ARCHTICK")       ;第二个箭头块名 建筑标记
            (setvar "DIMLDRBLK" "_DOT")          ;引线箭头
            (setvar "DIMASZ" 1.1)                ;箭头大小
            (setvar "DIMCEN" 1)                  ;圆心标记大小
            (setvar "DIMTXSTY" txtName1)         ;文字样式
            (setvar "DIMTXT" (atof dimHeight1))  ;文字高度
            (setvar "DIMGAP" 0.625)              ;从尺寸线偏移
            (setvar "DIMTIX" 1)                  ;文字始终保持在尺寸界线之间
            (setvar "DIMTMOVE" 1)                ;尺寸线上方，加引线
            (setvar "DIMSCALE" (atoi dimScale1)) ;值=0，将标注缩放到布局；值>0使用全局比例
            (setvar "DIMLUNIT" 2)                ;单位格式
            (setvar "DIMDEC" 0)                  ;精度
            (setvar "DIMDSEP" ".")               ;小数分格符
            (setvar "DIMZIN" 8)                  ;消零
            (command "-dimstyle" "S" dimName1)
            (princ (strcat "\n标注样式：" dimName1 " 创建成功！"))
        )(princ (strcat "\n标注样式：" txtName1 " 已存在！"))
    )(princ)
)
;;;-------------------------------------------------------------------

zmzk

能用的寥寥无几，而且这种 面板  不直观！贴上图来，让更多的后面同志看到，避免浪费金币下载！

毒眼

貌似水平不行啊

LIULISHENG

不是源码还收币

tianyi1230

看起来是个工具箱的面板啊！

tianyi1230

为嘛不源码，不是源码还收币，这个不也是你在网上找的吗？

uvyx

tianyi1230 发表于 2016-1-21 08:15
为嘛不源码，不是源码还收币，这个不也是你在网上找的吗？

没办法，里面的很多都是网上找的，怕粘出来！！！

uvyx

工具不断添加中！！

429014673

请注明是lee作品

tianyi1230

uvyx 发表于 2016-1-21 09:38
没办法，里面的很多都是网上找的，怕粘出来！！！

不是源码怎么研究？

zhengchuan

嘛不源码，不是源码还收币，这个不也是你在网上找的吗？

松树石头哥