设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 9846|回复: 46

[原创] Excel表格转CAD表格 源码

[复制链接]

签到天数: 1407 天

连续签到: 2 天

[LV.10]以坛为家III

已领礼包: 3651个

财富等级: 富可敌国

发表于 2013-12-1 01:57:52 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

x
  1. ;;;--------------------------------------------------;;;
  2. ;;;Range对象的几个属性和方法:                       ;;;
  3. ;;;--------------------------------------------------;;;
  4. ;;;属性:                                            ;;;
  5. ;;; Address----地址,如"$A$1" "$A$1:$C$4"            ;;;
  6. ;;;                     这个属性需要三个参数:       ;;;
  7. ;;;                     :vlax-true :vlax-true 1      ;;;
  8. ;;; Borders----单元格边框                            ;;;
  9. ;;; Characters----返回单元格字符串中的单个字符对象   ;;;
  10. ;;;    两个参数 start length                         ;;;
  11. ;;; Borders----单元格边框                            ;;;
  12. ;;; Column----返回指定区域第一列的列号               ;;;
  13. ;;; Columns----所有列集合                            ;;;
  14. ;;; End----指定区域尾端的单元格                      ;;;
  15. ;;; -4121 向下 -4159 向左 -4161 向右 -4162 向上      ;;;
  16. ;;; HorizontalAlignment----水平对齐方式              ;;;
  17. ;;;         1 常规 -4131 靠左 -4108 居中 -4152 靠右  ;;;
  18. ;;;         5 填充 -4130 两端 7 跨列居中 -4117 分散  ;;;
  19. ;;; IndentLevel----缩进 0--15                        ;;;
  20. ;;; MergeArea----返回Range对象,如果单元格不被包含合 ;;;
  21. ;;;    并格,就返回单元格本身。                      ;;;
  22. ;;; Next----下一个单元格对象                         ;;;
  23. ;;; Previous----上一个单元格                         ;;;
  24. ;;; Range----"A1" "A1:D3" "$A$1:$B$2"                ;;;
  25. ;;; Row----返回指定区域第一排                        ;;;
  26. ;;; Text----返回或设置单元格的文本                   ;;;
  27. ;;; Value----返回或设置单元格的值                    ;;;
  28. ;;; Value2----返回或设置单元格的值                   ;;;
  29. ;;; VerticalAlignment----垂直对齐方式                ;;;
  30. ;;; -4160靠上 -4108居中 -4107靠下 -4130两端 -4117分散;;;
  31. ;;;--------------------------------------------------;;;
  32. ;;;Font字体对象的属性                                ;;;
  33. ;;; Background: 背景颜色                             ;;;
  34. ;;;   XlBackground常量                               ;;;
  35. ;;;    xlBackgroundAutomatic=-4105 Excel控制背景     ;;;
  36. ;;;    xlBackgroundOpaque=3 不透明背景               ;;;
  37. ;;;    xlBackgroundTransparent=2 透明背景            ;;;
  38. ;;; Bold: 是否加粗 Boolean值                         ;;;
  39. ;;; Color: 字体颜色 RGB值                            ;;;
  40. ;;; ColorIndex: 字体颜色索引号值                     ;;;
  41. ;;; FontStyle: 字体样式名 string                     ;;;
  42. ;;; Italic: 是否倾斜 Boolean值                       ;;;
  43. ;;; Name: 字体名 string                              ;;;
  44. ;;; Size: 字号                                       ;;;
  45. ;;; Strikethrough: 中间删除线 Boolean值              ;;;
  46. ;;; Subscript: 下标 Boolean值                        ;;;
  47. ;;; Superscript: 上标 Boolean值                      ;;;
  48. ;;; TintAndShade: 字体亮度 -1 最暗 1 最亮            ;;;
  49. ;;; Underline: 下划线                                ;;;
  50. ;;;    xlUnderlineStyleDouble=-4119 粗双下划线       ;;;
  51. ;;;    xlUnderlineStyleDoubleAccounting=5 细双下划线 ;;;
  52. ;;;    xlUnderlineStyleNone=-4142 无下划线           ;;;
  53. ;;;    xlUnderlineStyleSingle=2 单下划线             ;;;
  54. ;;;    xlUnderlineStyleSingleAccounting=4 不支持     ;;;
  55. ;;;--------------------------------------------------;;;
  56. ;;;       替换编辑器设置多行文字的格式               ;;;
  57. ;;; \~          插入不间断空格                       ;;;
  58. ;;; \\          插入反斜杠                           ;;;
  59. ;;; \{...\}     插入大括号                           ;;;
  60. ;;; \Avalue;    设置对齐方式                         ;;;
  61. ;;;             0--底端对正                          ;;;
  62. ;;;             1--居中对正                          ;;;
  63. ;;;             2--顶端对正                          ;;;
  64. ;;; \Cvalue;    设置颜色                             ;;;
  65. ;;; \Ffilename; 设置字体文件                         ;;;
  66. ;;; \Hvalue;    设置高度                             ;;;
  67. ;;; \Hvaluex;   设置当前字体高度的倍数               ;;;
  68. ;;; \L...\l     打开或关闭下划线                     ;;;
  69. ;;; \O...\o     打开或关闭删除线(上划线)             ;;;
  70. ;;; ...\P       结束段落                             ;;;
  71. ;;; \Qangle;    设置倾斜角度                         ;;;
  72. ;;; \S...^...;  设置堆叠                             ;;;
  73. ;;;             /--除号                              ;;;
  74. ;;;             #--斜线                              ;;;
  75. ;;;             ^--上下界                            ;;;
  76. ;;; \Tvalue;    设置字符间距,有效值0.75-4倍         ;;;
  77. ;;; \Wvalue;    设置宽度比例                         ;;;
  78. ;;;--------------------------------------------------;;;
  79. ;;;Borders 集合对象的 item 属性                      ;;;
  80. ;;; (vlax-get-property Borders 'Item xlEdgeLeft)     ;;;
  81. ;;; 返回一个Border对象                               ;;;
  82. ;;; xlDiagonalDown     = 5 左上角至右下角            ;;;
  83. ;;; xlDiagonalUp       = 6 左下角至右上角            ;;;
  84. ;;; xlEdgeBottom       = 9 区域底部                  ;;;
  85. ;;; xlEdgeLeft         = 7 区域左边                  ;;;
  86. ;;; xlEdgeRight        =10 区域右边                  ;;;
  87. ;;; xlEdgeTop          = 8 区域顶部                  ;;;
  88. ;;; xlInsideHorizontal =12 所有水平边框              ;;;
  89. ;;; xlInsideVertical   =11 所有垂直边框              ;;;
  90. ;;;--------------------------------------------------;;;
  91. ;;;Border 对象的 LineStyle 属性                      ;;;
  92. ;;; (vlax-get-property Border 'LineStyle)            ;;;
  93. ;;; xlContinuous        1 实线。                     ;;;
  94. ;;; xlDash          -4115 虚线。                     ;;;
  95. ;;; xlDashDot           4 点划相间线。               ;;;
  96. ;;; xlDashDotDot        5 划线后跟两个点。           ;;;
  97. ;;; xlDot           -4118 点式线。                   ;;;
  98. ;;; xlDouble        -4119 双线。                     ;;;
  99. ;;; xlLineStyleNone -4142 无线条。                   ;;;
  100. ;;; xlSlantDashDot     13 倾斜的划线。               ;;;
  101. ;;;--------------------------------------------------;;;

  102. ;;;--------------------------------- 开始 ---------------------------------;;;

  103. (vl-load-com)
  104. ;;;将单位磅转换成毫米
  105. (defun AYL-ConvertUnit (ENumber)
  106.   (/ (* ENumber 25.4) 72)
  107. )
  108. ;;;将真彩色值转换成RGB三色的表
  109. (defun AYL-i->RGB (c)
  110.   (list  (lsh c -16)
  111.   (lsh (lsh c 16) -24)
  112.   (lsh (lsh c 24) -24)
  113.   )
  114. )
  115. ;;;将RGB转换成真彩色值   
  116. ;;;(defun AYL-RBG->i (Lst)
  117. ;;;  (+ (lsh (car Lst) 16)
  118. ;;;     (lsh (cadr Lst) 8)
  119. ;;;     (caddr Lst)      
  120. ;;;  )                    
  121. ;;;)                     

  122. ;;;将Excel真彩色值转换成AutoCAD颜色索引号
  123. (defun AYL-tColorCiColor (TrueColor / AcadApp AccVer cObj AppLst ci)
  124.   (setq ci nil)
  125.   (setq AcadApp (vlax-get-acad-object)
  126.   AccVer  (strcat "AutoCAD.AcCmColor." (substr (getvar 'AcadVer) 1 2))
  127.   )
  128.   (setq cObj (vl-catch-all-apply 'vla-getinterfaceobject (list AcadApp AccVer)))
  129.   (if (vl-catch-all-error-p cObj)
  130.     (vlax-release-object AcadApp)
  131.     (progn
  132.       (setq AppLst (reverse (AYL-i->RGB TrueColor)))
  133.       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-setRGB (cons cObj AppLst))))
  134.   (setq ci (vla-get-ColorIndex cObj))
  135.       )
  136.       (mapcar 'vlax-release-object (list AcadApp cObj))
  137.     )
  138.   )
  139.   ci
  140. )
  141. (defun AYL-GetColorIndex (Int)
  142.   (if (member Int '(0 16777215))
  143.     (setq Int (- 16777215 Int))
  144.   )
  145.   (AYL-tColorCiColor Int)
  146. )
  147. ;;;--------------- AYL-GetStringProp 函数 ---------------;;;
  148. ;;; (AYL-GetStringProp CellObj)                          ;;;
  149. ;;;单元格字符串的属性                                    ;;;
  150. ;;; CellObj 单元格或合并单元格对象                       ;;;
  151. ;;;返回格式化后的多行文字字符串,或nil。                 ;;;
  152. ;;;------------------------------------------------------;;;
  153. ;;;调用的子函数                                          ;;;
  154. ;;; AYL-ConvertUnit                                      ;;;
  155. ;;; AYL-tColorCiColor                                    ;;;
  156. ;;;------------------------------------------------------;;;
  157. (defun AYL-GetStringProp (CellObj /       string      oFont         isItalic isBold
  158.         vColor  vSize   vULine      sName         n        CharObj
  159.         CurStr  sChar   isSubscript isSuperscript vColor0  vSize0
  160.         sName0  isBold0 isItalic0   vULine0       sChar0   CTsize
  161.        )
  162.   (if (setq string (vlax-variant-value (vlax-get-property CellObj 'Text)))
  163.     (progn
  164.       (setq oFont    (vlax-get-property CellObj 'Font)
  165.       isItalic (vlax-variant-value (vlax-get-property oFont 'Italic))
  166.       isBold   (vlax-variant-value (vlax-get-property oFont 'Bold))
  167.       vColor   (vlax-variant-value (vlax-get-property oFont 'Color))
  168.       vSize    (/ (AYL-ConvertUnit (vlax-variant-value (vlax-get-property oFont 'Size))) 1.35)
  169.       vULine   (vlax-variant-value (vlax-get-property oFont 'Underline))
  170.       sName    (vlax-variant-value (vlax-get-property oFont 'Name))
  171.       CTsize   (getvar 'textsize) ;_ 当前默认字体大小
  172.       )
  173.       (vlax-release-object oFont)
  174.       ;;如果单元格存在多种颜色时,vColor的值为nil
  175.       (if vColor (setq vColor (fix vColor)))
  176.       
  177.       ;;---------- 单字符对象处理开始 ----------;;
  178.       
  179.       (setq n       1
  180.       CharObj (vlax-get-property CellObj 'Characters n 1)
  181.       CurStr  ""
  182.       *vSize* 0.0 ;_ 初始化字符串长度的值
  183.       )
  184.       (while (and
  185.          ;;字符对象不支持数字的Text属性
  186.          (setq sChar (vl-catch-all-apply 'vlax-get-property (list CharObj 'Text)))
  187.          (not (vl-catch-all-error-p sChar))
  188.          (/= sChar "")
  189.        )
  190.   ;;将三种特定的字符转换成LISP格式
  191.   (cond
  192.     ((= sChar "{") (setq sChar "\\{"))
  193.     ((= sChar "}") (setq sChar "\\}"))
  194.     ((= sChar "\\") (setq sChar "\\\\"))
  195.     (t nil)
  196.   )
  197.   (setq oFont         (vlax-get-property CharObj 'Font)
  198.         isSubscript   (vlax-variant-value (vlax-get-property oFont 'Subscript))
  199.         isSuperscript (vlax-variant-value (vlax-get-property oFont 'Superscript))
  200.         vColor0       (fix (vlax-variant-value (vlax-get-property oFont 'Color)))
  201.         vSize0        (/ (AYL-ConvertUnit (vlax-variant-value (vlax-get-property oFont 'Size))) 1.35)
  202.         *vSize*       (+ *vSize* vSize0)
  203.         vSize0        (/ vSize0 CTsize)
  204.         sName0        (vlax-variant-value (vlax-get-property oFont 'Name))
  205.         vULine0       (vlax-variant-value (vlax-get-property oFont 'Underline))
  206.         sChar0        sChar
  207.   )
  208.   (if (not (= isBold :vlax-true)) (setq isBold0 (vlax-variant-value (vlax-get-property oFont 'Bold))))
  209.   (if (not (= isItalic :vlax-true)) (setq isItalic0 (vlax-variant-value (vlax-get-property oFont 'Italic))))
  210.   (vlax-release-object oFont)
  211.   (if (= isSubscript :vlax-true) (setq sChar (strcat "\\A1;\\H" (rtos (* vSize0 0.6)) "x;\\S^" sChar ";"))) ;_ 下标
  212.         (if (= isSuperscript :vlax-true) (setq sChar (strcat "\\A1;\\H" (rtos (* vSize0 0.6)) "x;\\S" sChar "^;"))) ;_ 上标
  213.   (cond
  214.     ((and (/= vULine -4142) (= vULine0 -4142)) (setq sChar (strcat "\\l" sChar)))
  215.     ((and (= vULine -4142) (/= vULine0 -4142)) (setq sChar (strcat "\\L" sChar)))
  216.     (t nil)
  217.   )
  218.         (and sName0 (/= sName sName0) (setq sChar (strcat "\\F" sName0 ";" sChar)))
  219.         (if (= isBold0 :vlax-true) (setq sChar (strcat "\\W1.2;" sChar)))
  220.         (if (= isItalic0 :vlax-true) (setq sChar (strcat "\\Q18;" sChar)))
  221.   (and (/= vColor vColor0)
  222.     (progn
  223.             (setq vColor0 (AYL-GetColorIndex vColor0))
  224.             (setq sChar (strcat "\\C" (itoa vColor0) ";" sChar))
  225.     )
  226.   )
  227.   (if (not (equal vSize0 (/ vSize CTsize) 0.00001))
  228.           (setq sChar (strcat "\\H" (rtos vSize0 2 2) "x;" sChar))
  229.   )
  230.   (if (/= sChar0 sChar) (setq sChar (strcat "{" sChar "}")))
  231.   (setq CurStr (strcat CurStr  sChar))
  232.   (vlax-release-object CharObj)
  233.   (setq n         (1+ n)
  234.         CharObj  (vlax-get-property CellObj 'Characters n 1)
  235.   )
  236.       ) ;_ end while
  237.       (vlax-release-object CharObj)
  238.       ;;---------- 单字符对象处理结束 ----------;;
  239.       (if (= *vSize* 0.0) (setq *vSize* (* vSize (strlen string))))
  240.       (setq vSize (/ vSize CTsize))
  241.       (if (= CurStr "") (setq CurStr String))
  242.       (setq CurStr (strcat "{" CurStr "}"))
  243.       (if (/= vULine -4142) (setq CurStr (strcat "\\L" CurStr)))
  244.       (if sName (setq CurStr (strcat "\\F" sName ";" CurStr)))
  245.       (if (= isBold :vlax-true) (setq CurStr (strcat "\\W1.2;" CurStr)))
  246.       (if (= isItalic :vlax-true) (setq CurStr (strcat "\\Q18;" CurStr)))
  247.       (if vColor
  248.   (progn
  249.           ;;CAD的颜色转换系统用暗红色代替黑色
  250.           (setq vColor (AYL-GetColorIndex vColor))
  251.           (setq CurStr (strcat "\\C" (itoa vColor) ";" CurStr))
  252.   )
  253.       )
  254.       (setq CurStr (strcat "\\H" (rtos vSize 2 2) "x;" CurStr))
  255.     ) ;_ end progn
  256.   ) ;_ end if
  257. )
  258. ;;;--------------- AYL-GetBordersPr 函数 ---------------;;;
  259. ;;;(AYL-GetBordersPr RangeObj pt0 pt1 pt2 pat)          ;;;
  260. ;;;获取区域对象的边框属性,并设置给Acad表格相应方框。   ;;;
  261. ;;;                                                     ;;;
  262. ;;;RangeObj Excel区域对象                               ;;;
  263. ;;;pt0      方框的左上点                                ;;;
  264. ;;;pt1      方框的右上点                                ;;;
  265. ;;;pt2      方框的左下点                                ;;;
  266. ;;;pat      需要处理的边框类型,详细说明如下:          ;;;
  267. ;;;  1----上边线和左边线;                              ;;;
  268. ;;;  2----右边线;                                      ;;;
  269. ;;;  4----下边线;                                      ;;;
  270. ;;;  8----对角线。                                      ;;;
  271. ;;;-----------------------------------------------------;;;
  272. ;;;调用的子函数:                                       ;;;
  273. ;;; AYL-GetColorIndex                                   ;;;
  274. ;;;-----------------------------------------------------;;;
  275. (defun AYL-GetBordersPr (RangeObj pt0 pt1      pt2      pat      /
  276.        oBorders pt3 oBorder1 oBorder2 LnStyle1 LnStyle2
  277.        Color1   Color2)
  278.   (setq oBorders   (vlax-get-property RangeObj 'Borders)
  279.   pt3        (list (car pt1) (cadr pt2))
  280.   )
  281.   ;;如果pat参数包含1,就处理边框的上边线和左边线;
  282.   ;;如果pat参数包含2,就处理边框的右边线;
  283.   ;;如果pat参数包含4,就处理边框的下边线;
  284.   ;;如果pat参数包含8,就处理边框的对角线。
  285.   (if (= (logand pat 1) 1)
  286.     (progn
  287.       (setq oBorder1 (vlax-get-property oBorders 'Item 8)
  288.       oBorder2 (vlax-get-property oBorders 'Item 7)
  289.       LnStyle1 (vlax-variant-value (vlax-get-property oBorder1 'LineStyle))
  290.       LnStyle2 (vlax-variant-value (vlax-get-property oBorder2 'LineStyle))
  291.       )
  292.       (mapcar 'vlax-release-object (list oBorder1 oBorder2))
  293.       (if (/= LnStyle1 -4142)
  294.   (setq *HLineData* (cons (list pt0 pt1) *HLineData*))
  295.       )
  296.       (if (/= LnStyle2 -4142)
  297.   (setq *VLineData* (cons (list pt0 pt2) *VLineData*))
  298.       )
  299.     )
  300.   )
  301.   (if (= (logand pat 2) 2)
  302.     (progn
  303.       (setq oBorder1 (vlax-get-property oBorders 'Item 10)
  304.       LnStyle1 (vlax-variant-value (vlax-get-property oBorder1 'LineStyle))
  305.       )
  306.       (vlax-release-object oBorder1)
  307.       (if (/= LnStyle1 -4142)
  308.   (setq *VLineData* (cons (list pt1 pt3) *VLineData*))
  309.       )
  310.     )
  311.   )
  312.   (if (= (logand pat 4) 4)
  313.     (progn
  314.       (setq oBorder1 (vlax-get-property oBorders 'Item 9)
  315.       LnStyle1 (vlax-variant-value (vlax-get-property oBorder1 'LineStyle))
  316.       )
  317.       (vlax-release-object oBorder1)
  318.       (if (/= LnStyle1 -4142)
  319.   (setq *HLineData* (cons (list pt2 pt3) *HLineData*))
  320.       )
  321.     )
  322.   )
  323.   (if (= (logand pat 8) 8)
  324.     (progn
  325.       (setq oBorder1 (vlax-get-property oBorders 'Item 5)
  326.       oBorder2 (vlax-get-property oBorders 'Item 6)
  327.       LnStyle1 (vlax-variant-value (vlax-get-property oBorder1 'LineStyle))
  328.       LnStyle2 (vlax-variant-value (vlax-get-property oBorder2 'LineStyle))
  329.       Color1   (fix (vlax-variant-value (vlax-get-property oBorder1 'Color)))
  330.       Color2   (fix (vlax-variant-value (vlax-get-property oBorder2 'Color)))
  331.       )
  332.       (mapcar 'vlax-release-object (list oBorder1 oBorder2))
  333.       (if (/= LnStyle1 -4142)
  334.   (progn
  335.     (setq Color1 (AYL-GetColorIndex Color1))
  336.     (entmakex (list '(0 . "Line") (cons 10 pt0) (cons 11 pt3) (cons 62 Color1)))
  337.   )
  338.       )
  339.       (if (/= LnStyle2 -4142)
  340.   (progn
  341.     (setq Color2 (AYL-GetColorIndex Color2))
  342.     (entmakex (list '(0 . "Line") (cons 10 pt2) (cons 11 pt1) (cons 62 Color2)))
  343.   )
  344.       )
  345.     )
  346.   )
  347.   (vlax-release-object oBorders)
  348. )
  349. (defun AYL-ModString (k str n / m1 m2 ss)
  350.   (cond
  351.     ((and (setq m1 (vl-string-search "\\H" str n))
  352.     (setq m2 (vl-string-search "x;" str m1))
  353.      )
  354.      (setq ss (substr str (+ 3 m1) (- m2 m1 2)))
  355.      (AYL-ModString k (vl-string-subst (rtos (* (atof ss) k)) ss str n) m2)
  356.     )
  357.     (t str)
  358.   )
  359. )
  360. ;;;--------------- AYL-FixText 函数 ---------------;;;
  361. ;;; (AYL-FixText EnText MinPnt MaxPnt)             ;;;
  362. ;;;把自动换行的多行文字缩小以取消自动换行          ;;;
  363. ;;;------------------------------------------------;;;
  364. ;;;这个函数有问题                                  ;;;
  365. ;;;????????????????????????????????????????????????;;;
  366. (defun AYL-FixText (EnText MinPnt MaxPnt / EnData kkkk width)
  367.   ;;如果文字的高度大于方框的高度
  368.   (if (> (cdr (assoc 43 (entget EnText))) (- (cadr MaxPnt) (cadr MinPnt)))
  369.     (progn
  370.       (setq EnText (vlax-ename->vla-object EnText))
  371.       (vla-put-width EnText (* *vSize* 1.25))
  372.       (setq kkkk (/ (setq Width (- (car MaxPnt) (car MinPnt)))
  373.         (cdr (assoc 42 (setq EnData (entget (vlax-vla-object->ename EnText)))))
  374.      )
  375.       )
  376.       (vla-put-textstring
  377.   EnText
  378.   (AYL-ModString kkkk (cdr (assoc 1 EnData)) 0)
  379.       )
  380.       (vla-put-width EnText width)
  381.       (vlax-release-object EnText)
  382.     )
  383.   )
  384.   (setq *vSize* nil)
  385. )
  386. ;;;--------------- AYL-ControlMA 函数 ---------------;;;
  387. ;;;AYL-ControlMA 子函数有两个功能                    ;;;
  388. ;;;1 绘制文字图元                                    ;;;
  389. ;;;2 返回单元格上边线和左边线的表,边线用点对表表示  ;;;
  390. ;;;(AYL-ControlMA RangeObj InitPt)                   ;;;
  391. ;;;RangeObj 合并区域的vla对象                        ;;;
  392. ;;;InitPt   左上点                                   ;;;
  393. ;;;--------------------------------------------------;;;
  394. ;;;调用的子函数:                                    ;;;
  395. ;;; AYL-ConvertUnit                                  ;;;
  396. ;;; AYL-GetStringProp                                ;;;
  397. ;;; AYL-GetBordersPr                                 ;;;
  398. ;;; AYL-FixText (目前还只是个空函数)                 ;;;
  399. ;;;--------------------------------------------------;;;
  400. (defun AYL-ControlMA (RangeObj InitPt /      Width  Height RetPnt
  401.           String   HAlign VAlign IndLvl Align  MaCells
  402.           lusPnt   lrsPnt
  403.          )
  404.   (setq Width   (AYL-ConvertUnit (vlax-variant-value (vlax-get-property RangeObj 'Width)))
  405.   Height  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property RangeObj 'Height)))
  406.   lusPnt  InitPt
  407.   lrsPnt  (polar InitPt (* pi 1.5) Height)
  408.   RetPnt  (polar InitPt 0.0 Width)
  409.   String  nil
  410.   MaCells (vlax-get-property RangeObj 'Cells)
  411.   )
  412.   (vlax-for Item MaCells
  413.     (if (not String)
  414.       (setq String (AYL-GetStringProp Item))
  415.     )
  416.     (vlax-release-object Item)
  417.   )
  418.   (vlax-release-object MaCells)
  419.   (if String
  420.     (progn
  421.       ;;水平对正方式、垂直对正方式、缩进值
  422.       (setq HAlign (vlax-variant-value (vlax-get-property RangeObj 'HorizontalAlignment))
  423.       VAlign (vlax-variant-value (vlax-get-property RangeObj 'VerticalAlignment))
  424.       IndLvl (vlax-variant-value (vlax-get-property RangeObj 'IndentLevel))
  425.       IndLvl (* (AYL-ConvertUnit (* IndLvl 19.05)) 1.25)
  426.       *isStr* t ;_ 临时的全局变量,暂时没用
  427.       )
  428.       (cond ((and (= HAlign 1)
  429.       (numberp (read String))
  430.        )
  431.        (setq HAlign -4152)
  432.       )
  433.       ((and (= HAlign 1) (not (numberp (read String))))
  434.         (setq HAlign -4131)
  435.       )
  436.             ((= HAlign -4130) (setq HAlign -4108))
  437.       ((= HAlign -4117) (setq HAlign -4108))
  438.       ((= HAlign 5) (setq HAlign -4108))
  439.       (t nil)
  440.       )
  441.       (cond ((= VAlign -4130) (setq VAlign -4108))
  442.       ((= VAlign -4117) (setq VAlign -4108))
  443.       (t nil)
  444.       )
  445.       ;;文本文字的插入点和对正方式
  446.       (cond
  447.   ((and (= HAlign -4131) (= VAlign -4160))
  448.    (setq Align 1
  449.          InitPt (polar InitPt 0.0 IndLvl)
  450.          )
  451.   )
  452.   ((and (= HAlign -4131) (= VAlign -4108))
  453.    (setq Align  4
  454.          InitPt (polar InitPt (* pi 1.5) (* Height 0.5))
  455.          InitPt (polar InitPt 0.0 IndLvl)
  456.    )
  457.   )
  458.   ((and (= HAlign -4131) (= VAlign -4107))
  459.    (setq Align  7
  460.          InitPt (polar InitPt (* pi 1.5) Height)
  461.          InitPt (polar InitPt 0.0 IndLvl)
  462.    )
  463.   )
  464.   ((and (= HAlign -4108) (= VAlign -4160))
  465.    (setq Align  2
  466.          InitPt (polar InitPt 0.0 (* Width 0.5))
  467.    )
  468.   )
  469.   ((and (= HAlign -4108) (= VAlign -4108))
  470.    (setq Align  5
  471.          InitPt (polar InitPt 0.0 (* Width 0.5))
  472.          InitPt (polar InitPt (* pi 1.5) (* Height 0.5))
  473.    )
  474.   )
  475.   ((and (= HAlign -4108) (= VAlign -4107))
  476.    (setq Align  8
  477.          InitPt (polar InitPt 0.0 (* Width 0.5))
  478.          InitPt (polar InitPt (* pi 1.5) Height)
  479.    )
  480.   )
  481.   ((and (= HAlign -4152) (= VAlign -4160))
  482.    (setq Align  3
  483.          InitPt (polar InitPt 0.0 Width)
  484.          InitPt (polar InitPt pi IndLvl)
  485.    )
  486.   )
  487.   ((and (= HAlign -4152) (= VAlign -4108))
  488.    (setq Align  6
  489.          InitPt (polar InitPt 0.0 Width)
  490.          InitPt (polar InitPt (* pi 1.5) (* Height 0.5))
  491.          InitPt (polar InitPt pi IndLvl)
  492.    )
  493.   )
  494.   ((and (= HAlign -4152) (= VAlign -4107))
  495.    (setq Align  9
  496.          InitPt (polar InitPt 0.0 Width)
  497.          InitPt (polar InitPt (* pi 1.5) Height)
  498.          InitPt (polar InitPt pi IndLvl)
  499.    )
  500.   )
  501.   (t (setq Align 4))
  502.       )
  503.       (AYL-FixText
  504.   (entmakex
  505.     (list
  506.       '(0 . "MText")
  507.       '(100 . "AcDbEntity")
  508.       '(100 . "AcDbMText")
  509.       (cons 1 String)
  510.       (cons 10 InitPt)
  511.       (cons 41 (/ Width 1.35))
  512.       (cons 71 Align)
  513.     )
  514.   )
  515.   lrsPnt
  516.   RetPnt
  517.       )
  518.     )
  519.   ) ;_ end if
  520.   (AYL-GetBordersPr RangeObj lusPnt RetPnt lrsPnt 9)
  521.   (list (list lusPnt RetPnt) (list lusPnt lrsPnt))
  522. )
  523. ;;;--------------- AYL-DrawRange 函数 ---------------;;;
  524. ;;;根据点对表绘制直线                                ;;;
  525. ;;;(AYL-DrawRange DPntsLst)                          ;;;
  526. ;;;DPntsLst 子表是点对表,表示单元格的一条边线       ;;;
  527. ;;;   指所有上边线或者所有左边线,顺序是颠倒的       ;;;
  528. ;;;--------------------------------------------------;;;
  529. (defun AYL-DrawRange (DPntsLst Cint / Lst0 Lst1 Item0 Item1 Pnt)
  530.   (setq  Lst0 (reverse DPntsLst)
  531.   Lst1 nil
  532.   )
  533.   ;;按顺序将共线的直线合并
  534.   (while Lst0
  535.     (setq Item0  (car Lst0)
  536.     Pnt  (cadr Item0)
  537.     Lst0  (cdr Lst0)
  538.     )
  539.     (while (setq
  540.        Item1 (car  (vl-member-if
  541.         (function
  542.           (lambda (x)
  543.             (equal (distance Pnt (car x)) 0 0.00001)
  544.           )
  545.         )
  546.         Lst0
  547.       )
  548.        )
  549.      )
  550.       (setq Pnt    (cadr Item1)
  551.       Item0 (list (car Item0) Pnt)
  552.       Lst0  (vl-remove Item1 Lst0)
  553.       )
  554.     )
  555.     (setq Lst1 (cons Item0 Lst1))
  556.   )
  557.   ;;用Entmakex函数绘制直线
  558.   (mapcar
  559.     (function
  560.       (lambda (x)
  561.   (entmakex
  562.     (list '(0 . "Line") (cons 10 (car x)) (cons 11 (cadr x)) (cons 62 Cint))
  563.   )
  564.       )
  565.     )
  566.     Lst1
  567.   )
  568. )
  569. ;;;-------------------- AYL-GetExcPr 函数 --------------------;;;
  570. ;;; (AYL-GetExcPr Range AlPnt)                                ;;;
  571. ;;; 把指定的Excel表格对象绘制在AutoCAD制图界面                ;;;
  572. ;;; Range Excel表格对象,指定要在AutoCAD制图界面绘制的表格    ;;;
  573. ;;; AlPnt 制图界面插入点,指定表格的左上点                    ;;;
  574. ;;;-----------------------------------------------------------;;;
  575. ;;; 调用的子函数:                                            ;;;
  576. ;;; AYL-ControlMA                                             ;;;
  577. ;;; AYL-ConvertUnit                                           ;;;
  578. ;;; AYL-DrawRange                                             ;;;
  579. ;;; AYL-GetBordersPr                                          ;;;
  580. ;;;-----------------------------------------------------------;;;
  581. (defun AYL-GetExcPr (Range  AlPnt /     Rows   CeLst
  582.          luPnt  Cells MArea MaAddr CeAddr
  583.          DPtLst RowH  RowW  rlPnt  ruPnt
  584.          *HLineData*  *VLineData*  *isStr*
  585.          n      m     CellW CellH
  586.         )
  587.   (setq  Rows   (vlax-get-property Range 'Rows) ;_ 所有行的集合对象
  588.   n      (vlax-get-property Rows 'Count)
  589.   DPtLst nil
  590.   CeLst  nil
  591.   luPnt  AlPnt
  592.   *HLineData* nil
  593.   *VLineData* nil
  594.   )
  595.   (vlax-for Item0 Rows
  596.     (setq Cells (vlax-get-property Item0 'Cells) ;_ 每一行所有单元格的集合对象
  597.     m     (vlax-get-property Cells 'Count)
  598.     n     (1- n)
  599.     *isStr* nil
  600.     )
  601.     (vlax-for Item1 Cells
  602.       ;;获取单元格的合并区域,绝对地址
  603.       (setq MArea  (vlax-get-property Item1 'MergeArea) ;_ 单元格被包含的合并区域对象
  604.       MaAddr (vlax-get-property MArea 'Address :vlax-true :vlax-true 1) ;_ 合并区域的绝对地址
  605.       CeAddr (vlax-get-property Item1 'Address :vlax-true :vlax-true 1) ;_ 单元格的绝对地址
  606.       CellW  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Item1 'Width)))
  607.       CellH  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Item1 'Height)))
  608.       m      (1- m)
  609.       )
  610.       (if (= m 0) (AYL-GetBordersPr Item1 AlPnt (polar AlPnt 0.0 CellW) (polar AlPnt (* pi 1.5) CellH) 2))
  611.       (if (= n 0) (AYL-GetBordersPr Item1 AlPnt (polar AlPnt 0.0 CellW) (polar AlPnt (* pi 1.5) CellH) 4))
  612.       (cond
  613.   ;;如果地址相同,说明单元格不被包含于合并区域
  614.   ;;那么,就对此单元格进行文字和边框的处理   
  615.   ((equal MaAddr CeAddr)
  616.    (setq DPtLst (cons (AYL-ControlMA MArea luPnt) DPtLst)
  617.          luPnt  (cadaar DPtLst)
  618.    )
  619.   )
  620.   ;;如果地址不相同,而且单元格被包含的合并区域还没被保存
  621.   ;;那么,就把这个合并区域的绝对地址保存在表CeLst中     
  622.   ;;并对此单元格进行文字和边框的处理                    
  623.   ((not (member MaAddr CeLst))
  624.    (setq CeLst (append CeLst (list MaAddr)))
  625.    (setq DPtLst (cons (AYL-ControlMA MArea luPnt) DPtLst)
  626.          luPnt  (cadaar DPtLst)
  627.    )
  628.   )
  629.   ;;如果地址不相同,单元格被包含的合并区域已经被保存
  630.   ;;而且单元格不是合并区域的第一行                  
  631.   ;;那么,改变左上点前进当前单元格的一个宽度,而不对
  632.   ;;单元格进行文字和边框的处理                     
  633.   ((and (member MaAddr CeLst)
  634.         (not (wcmatch CeAddr (strcat "*" (itoa (vlax-get-property MArea 'Row)))))
  635.    )
  636.    (setq luPnt (polar luPnt 0.0 CellW))
  637.   )
  638.   (t nil)
  639.       )
  640.       (mapcar 'vlax-release-object (list Item1 MArea))
  641.       (setq AlPnt (polar AlPnt 0.0 CellW))
  642.     )
  643.     ;;换行,把左上点移动到下一行的左上点
  644.     (setq RowH  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Item0 'Height)))
  645.     RowW  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Item0 'Width)))
  646.     luPnt (polar (polar luPnt pi RowW) (* pi 1.5) RowH)
  647.     AlPnt luPnt
  648.     )
  649.     (mapcar 'vlax-release-object (list Item0 Cells))
  650.   )
  651.   (vlax-release-object Rows)
  652.   ;;根据点对表绘制表格
  653.   (if (and (not *HLineData*) (not *VLineData*))
  654.     (progn
  655.       (mapcar 'AYL-DrawRange (apply 'mapcar (cons 'list DPtLst)) '(8 8))
  656.       ;;最后绘制使用区域的下边线和右边线
  657.       (setq RowH  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Range 'Height)))
  658.       RowW  (AYL-ConvertUnit (vlax-variant-value (vlax-get-property Range 'Width)))
  659.       rlPnt (polar luPnt 0.0 RowW)
  660.       ruPnt (polar rlPnt (* pi 0.5) RowH)
  661.       )
  662.       (entmakex (list '(0 . "Line") (cons 10 luPnt) (cons 11 rlPnt) '(62 . 8)))
  663.       (entmakex (list '(0 . "Line") (cons 10 ruPnt) (cons 11 rlPnt) '(62 . 8)))
  664.     )
  665.   )
  666.   (if *HLineData*
  667.     (AYL-DrawRange *HLineData* 7)
  668.   )
  669.   (if *VLineData*
  670.     (AYL-DrawRange *VLineData* 7)
  671.   )
  672.   nil
  673. )
  674. ;;;-------------------- 主命令 XlCAc --------------------;;;
  675. ;;; auther: 秋  寒                                       ;;;
  676. ;;;     QQ: 982049859                                    ;;;
  677. ;;;调用 AYL-GetExcPr 子函数                              ;;;
  678. ;;;------------------------------------------------------;;;
  679. (defun c:XlCAc (/ TtLst ExcApp Wkbk Sheet URange Cells InsPt)
  680.   (setq  TtLst (list vl-catch-all-apply   set
  681.         "作者:秋  寒"   vlax-get-object
  682.         +       "QQ:982049859"
  683.         vlax-release-object   -
  684.         "\000\001\002\003\004\005\006\007\010"
  685.         vlax-variant-value   boole
  686.         "????????????????????????????????????"
  687.         mapcar     entdel
  688.         "\011\012\013\014\015\016\017\020\021"
  689.         entmakex     logand
  690.         "\022\023\024\025\026\027\030\031\032"
  691.         cons     entsel
  692.         "作者:秋  寒"   vlax-for
  693.         entget     "QQ:982049859"
  694.         progn     entmake
  695.         vl-catch-all-error-p logior
  696.         "QQ:982049859"   setq
  697.         vlax-3d-point   getpoint
  698.         vla-addLine     "QQ:982049859"
  699.         defun     substr
  700.         function     getvar
  701.         "QQ:982049859"   lambda
  702.         command     polar
  703.         distance     "QQ:982049859"
  704.         not       reverse
  705.         pi       setvar
  706.         "QQ:982049859"   member
  707.         abs       strcat
  708.         numberp     "QQ:982049859"
  709.         wcmatch     <
  710.         append     >
  711.         "QQ:982049859"   cadaar
  712.         cdr       vl-remove
  713.         caddr     "QQ:982049859"
  714.         *       cadddr
  715.         car       cddr
  716.         "QQ:982049859"   cadr
  717.         =       /=
  718.         cdddr     "QQ:982049859"
  719.         itoa     read
  720.         1-       vlax-get-object
  721.         "QQ:982049859"   vlax-get-acad-object
  722.         vlax-get-or-create-object
  723.         /       vlax-curve-getstartpoint
  724.         "QQ:982049859"   fix
  725.         vlax-curve-getendpoint
  726.         equal     vlax-safearray->list
  727.         "QQ:982049859"   rtos
  728.         vl-string->list   :vlax-true
  729.         vlax-ename->vla-object
  730.         "QQ:982049859"   vlax-make-variant
  731.         vla-getinterfaceobject
  732.         vla-setRGB     vla-get-modelspace
  733.         "QQ:982049859"   vla-addMtext
  734.         vla-move     vl-list->string
  735.         vla-get-ActiveDocument
  736.         "QQ:982049859"   vla-get-ColorIndex
  737.         ssget     princ
  738.         prin1
  739.        )
  740.   )
  741.   ;;防破译
  742.   (if (apply 'and TtLst)
  743.     (progn
  744.       ;;提示用户先打开被操作的Excel文件,再继续执行
  745.       (alert "需要先打开被操作的Excel文件")
  746.       (if (setq ExcApp (vlax-get-object "Excel.Application")) ;_ Excel应用程序对象
  747.   (if (setq Wkbk (vlax-get-property ExcApp 'ActiveWorkbook)) ;_ 当前工作簿
  748.     (progn
  749.       (setq Sheet   (vlax-get-property Wkbk 'ActiveSheet) ;_ 当前工作表
  750.       URange (vlax-get-property Sheet 'UsedRange) ;_ 当前使用的区域
  751.       Cells   (vlax-get-property URange 'Cells) ;_ 已经使用区域的所有单元格集合
  752.       )
  753.       ;;判断当前工作表是否是空的
  754.       (if (and
  755.       (= (vlax-get-property Cells 'Count) 1)
  756.       (not (vlax-variant-value (vlax-get-property URange 'Value)))
  757.     )
  758.          (princ "\n当前工作表是空的")
  759.          ;;如果不是空的,提示用户在制图界面指定插入点
  760.          (if (setq InsPt (getpoint "\n指定表格的插入点<左上点>:"))
  761.       ;;根据使用区域对象和插入点绘制表格
  762.       (AYL-GetExcPr URange InsPt)
  763.          )
  764.       )
  765.       ;;释放对象
  766.       (mapcar 'vlax-release-object (list ExcApp Wkbk Sheet URange Cells))
  767.     )
  768.     (progn (princ "\n没有打开Excel文件") (vlax-release-object ExcApp))
  769.   )
  770.       )
  771.     )
  772.     (princ "函数错误")
  773.   )
  774.   (princ)
  775. )

  776. (princ "\n将Excel表格转换为Acad表格的命令名是:XlCAc")
  777. (princ "\n有bug请联系:QQ----982049859")
  778. (princ)

  779. ;;;------------------------------ 结束 ------------------------------;;;

评分

参与人数 1威望 +1 D豆 +10 贡献 +2 收起 理由
XDSoft + 1 + 10 + 2 很给力!经验;技术要点;资料分享奖!

查看全部评分

本帖被以下淘专辑推荐:

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

签到天数: 1388 天

连续签到: 13 天

[LV.10]以坛为家III

已领礼包: 604个

财富等级: 财运亨通

发表于 2013-12-5 16:23:53 | 显示全部楼层
支持楼主源码共享
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 1990 天

连续签到: 88 天

[LV.Master]伴坛终老I

已领礼包: 5910个

财富等级: 富甲天下

发表于 2013-12-5 11:08:37 | 显示全部楼层
楼主放源码了,顶起来。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 950 天

连续签到: 1 天

[LV.10]以坛为家III

已领礼包: 836个

财富等级: 财运亨通

发表于 2013-12-2 10:56:16 | 显示全部楼层
ayl1004 发表于 2013-12-2 02:20
放源码主要的目的是让我们一起学习,要速度快,把单字符对象处理的那一块拿掉,速度会快很多。至于选择表 ...

呵呵,以前参照论坛的改过,感觉还是不好用,工作中基本都是用tt
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 1407 天

连续签到: 2 天

[LV.10]以坛为家III

已领礼包: 3651个

财富等级: 富可敌国

 楼主| 发表于 2013-12-2 02:20:51 | 显示全部楼层
hao3ren 发表于 2013-12-1 12:58
测试了一下,转出速度较慢,效果不太好,还需完善

放源码主要的目的是让我们一起学习,要速度快,把单字符对象处理的那一块拿掉,速度会快很多。至于选择表格区域,哥们应该会弄吧。

点评

呵呵,以前参照论坛的改过,感觉还是不好用,工作中基本都是用tt  详情 回复 发表于 2013-12-2 10:56
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 1962 天

连续签到: 141 天

[LV.Master]伴坛终老I

已领礼包: 5435个

财富等级: 富甲天下

发表于 2013-12-2 00:05:26 | 显示全部楼层
的确,转换速度有些慢得不能接受;对于有合并单元格的表,无法生成表格线;最麻烦的是不能选择转换的范围
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 1779 天

连续签到: 12 天

[LV.Master]伴坛终老I

已领礼包: 4452个

财富等级: 富可敌国

发表于 2013-12-1 14:45:06 | 显示全部楼层
谢谢提供,试用一下!!辛苦了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 950 天

连续签到: 1 天

[LV.10]以坛为家III

已领礼包: 836个

财富等级: 财运亨通

发表于 2013-12-1 12:58:06 | 显示全部楼层
测试了一下,转出速度较慢,效果不太好,还需完善

点评

放源码主要的目的是让我们一起学习,要速度快,把单字符对象处理的那一块拿掉,速度会快很多。至于选择表格区域,哥们应该会弄吧。  详情 回复 发表于 2013-12-2 02:20
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 220 天

连续签到: 1 天

[LV.7]常住居民III

发表于 2013-12-1 12:40:08 | 显示全部楼层
经测试,还是沙发说的方法好用些!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 0 反对 1

使用道具 举报

签到天数: 1012 天

连续签到: 1 天

[LV.10]以坛为家III

点击这里给我发消息

已领礼包: 1255个

财富等级: 财源广进

发表于 2013-12-1 06:50:29 来自手机 | 显示全部楼层
本帖最后由 st788796 于 2013-12-1 06:53 编辑

支持楼主,看看和G版的有什么区别
不过通过简单设置直接用"选择性粘帖"就可以"原模原样"的转过来,无需任何程序

点评

能否搞一个这样的lisp程序?  发表于 2014-9-18 14:03
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1979 天

连续签到: 65 天

[LV.Master]伴坛终老I

已领礼包: 5554个

财富等级: 富甲天下

发表于 2013-12-1 08:21:49 | 显示全部楼层
本帖最后由 dwg001 于 2013-12-1 08:49 编辑

试用了下: 格子能转过来,但格子中的字转不过来,不知何故?  

呵呵,是字体配置问题,很好!   合并单元格这种特殊情况也能很好的转换.

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 950 天

连续签到: 1 天

[LV.10]以坛为家III

已领礼包: 836个

财富等级: 财运亨通

发表于 2013-12-1 12:58:46 | 显示全部楼层
另外最好能够增加选择区转换
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 26 天

连续签到: 1 天

[LV.4]偶尔看看III

已领礼包: 24个

财富等级: 恭喜发财

发表于 2014-1-9 13:12:15 | 显示全部楼层
只要是源码就一定要顶!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1388 天

连续签到: 13 天

[LV.10]以坛为家III

已领礼包: 604个

财富等级: 财运亨通

发表于 2014-1-9 13:15:42 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2014-1-9 13:25 编辑

LZ高手,我顶,顶!
如果可以置换选择部分,就更好了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 99 天

连续签到: 2 天

[LV.6]常住居民II

已领礼包: 170个

财富等级: 日进斗金

发表于 2014-1-11 16:12:07 | 显示全部楼层
支持源码啊:)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2018-10-22 15:23 , Processed in 0.183193 second(s), 67 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

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