设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：修正选择性粘贴的表格线
12下一页
返回列表 发新帖
查看: 1350|回复: 16

[LISP程序]：修正选择性粘贴的表格线

[复制链接]
mmmm
发表于 2004-7-19 12:30:42 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
使用选择性粘贴的Excel表格线往往不相交，这个小程序可以将表格线自动修正
使用时直接选取粘贴后的表格线就行了。

  3. (Defun c:fixtable (/           sset           idx           objx           obj           o10
  4.                    o11           minx-v  vtk           hot           maxy-h  maxy-hx
  5.                    minx-vx miny-h  miny-h-obj           osm           hor
  6.                    s10           s11     top
  7.                   )
  8.   (setq osm (getvar "osmode"))
  9.   (if (setq sset (ssget (list (cons 0 "line"))))
  10.     (progn
  11.       (setq idx         -1
  12.             objx (ssadd)
  13.       )
  14.       (repeat (sslength sset)
  15.         (setq obj (ssname sset (setq idx (1+ idx)))
  16.               o10 (cdr (assoc 10 (entget obj)))
  17.               o11 (cdr (assoc 11 (entget obj)))
  18.         )
  19.         (cond ((equal (car o10) (car o11) 0.01)
  20.                (if (or (null minx-v)
  21.                        (and minx-v (> minx-v (car o10)))
  22.                    )
  23.                  (setq minx-v (car o10)
  24.                        vtk    obj
  25.                  )
  26.                )
  27.               )
  28.               ((equal (cadr o10) (cadr o11) 0.01)
  29.                (ssadd obj objx)
  30.                (if (or (null maxy-h)
  31.                        (and maxy-h (< maxy-h (cadr o10)))
  32.                    )
  33.                  (setq maxy-h (cadr o10) top obj)
  34.                )
  35.                (if (or (null miny-h)
  36.                        (and miny-h (> miny-h (cadr o10)))
  37.                    )
  38.                  (setq miny-h (cadr o10)
  39.                        hor    obj
  40.                  )
  41.                )
  42.               )
  43.         )
  44.       )
  45.       (setq s10        (cdr (assoc 10 (entget hor)))
  46.             s11        (cdr (assoc 11 (entget hor)))
  47.       )
  48.       (if (> (car s10) (car s11))
  49.         (setq miny-h s11)
  50.         (setq miny-h s10)
  51.       )
  52.       (setq s10           (cdr (assoc 10 (entget vtk)))
  53.             s11           (cdr (assoc 11 (entget vtk)))            
  54.       )
  55.       (if (> (cadr s10) (cadr s11))
  56.         (setq minx-v s11)
  57.         (setq minx-v s10)
  58.       )
  59.       (setvar "osmode" 0)
  60.       (command "_.Move" objx "" miny-h minx-v)
  61.       (setq vtk        (entget vtk)
  62.             maxy-h (list (car minx-v) (cadr (cdr (assoc 10 (entget top)))))
  63.             vtk        (subst (cons 10 minx-v) (assoc 10 vtk) vtk)
  64.             vtk        (subst (cons 11 maxy-h) (assoc 11 vtk) vtk)
  65.       )
  66.       (entmod vtk)
  67.     )
  68.   )
  69.   (redraw)
  70.   (setvar "osmode" osm)
  71.   (princ)
  72. )
setq, minx, assoc

相关帖子

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

使用道具 举报

hnxychf
发表于 2004-7-24 18:50:15 | 显示全部楼层
程序是不是有问题，不起什么作用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

mmmm
 楼主| 发表于 2004-7-24 23:14:45 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
选择性粘贴的Excel表格线是POLYLINE
先炸开，再调用老程序

我将程序修改了一下，可以识别多义线了，同时顺便把所有文字的对齐方式改为MiddleCenter.

  3. (Defun c:fixtable (/          HOR         IDX        LL0    LL1    MAXY-H MINX-V
  4.                    MINY-H O10         O11        OBJ    OBJX   OBJY   OSM
  5.                    S10          S11         SSET        TOP    VLO    VTK
  6.                   )
  7.   (setq osm (getvar "osmode"))
  8.   (if (setq sset (ssget (list (cons 0 "*polyline,line,text"))))
  9.     (progn
  10.       (setq idx         -1
  11.             objx (ssadd)
  12.             objy (ssadd)
  13.       )
  14.       (repeat (sslength sset)
  15.         (setq obj (ssname sset (setq idx (1+ idx))))
  16.         (if (= (cdr (assoc 0 (entget obj))) "POLYLINE")
  17.           (progn
  18.             (command "_.Explode" obj)
  19.             (setq obj (entlast))
  20.           )
  21.         )
  22.         (cond ((= (cdr (assoc 0 (entget obj))) "TEXT")
  23.                (setq vlo (vlax-ename->vla-object obj)
  24.                      obj (entget obj)
  25.                )
  26.                (vla-getboundingbox vlo 'll0 'ur)
  27.                (setq obj (subst (cons 72 1) (assoc 72 obj) obj)
  28.                      obj (subst (cons 73 2) (assoc 73 obj) obj)
  29.                )
  30.                (entmod obj)
  31.                (vla-getboundingbox vlo 'll1 'ur)
  32.                (vla-move vlo ll1 ll0)
  33.               )
  34.               ((= (cdr (assoc 0 (entget obj))) "LINE")
  35.                (setq o10 (cdr (assoc 10 (entget obj)))
  36.                      o11 (cdr (assoc 11 (entget obj)))
  37.                )
  38.                (cond ((equal (car o10) (car o11) 0.01)
  39.                       (ssadd obj objy)
  40.                       (if (or (null minx-v)
  41.                               (and minx-v (> minx-v (car o10)))
  42.                           )
  43.                         (setq minx-v (car o10)
  44.                               vtk    obj
  45.                         )
  46.                       )
  47.                      )
  48.                      ((equal (cadr o10) (cadr o11) 0.01)
  49.                       (ssadd obj objx)
  50.                       (if (or (null maxy-h)
  51.                               (and maxy-h (< maxy-h (cadr o10)))
  52.                           )
  53.                         (setq maxy-h (cadr o10)
  54.                               top    obj
  55.                         )
  56.                       )
  57.                       (if (or (null miny-h)
  58.                               (and miny-h (> miny-h (cadr o10)))
  59.                           )
  60.                         (setq miny-h (cadr o10)
  61.                               hor    obj
  62.                         )
  63.                       )
  64.                      )
  65.                )
  66.               )
  67.         )
  68.       )
  69.       (if (= (type hor) (type vtk) 'ename)
  70.         (progn
  71.           (setq        s10 (cdr (assoc 10 (entget hor)))
  72.                 s11 (cdr (assoc 11 (entget hor)))
  73.           )
  74.           (if (> (car s10) (car s11))
  75.             (setq miny-h s11)
  76.             (setq miny-h s10)
  77.           )
  78.           (setq        s10 (cdr (assoc 10 (entget vtk)))
  79.                 s11 (cdr (assoc 11 (entget vtk)))
  80.           )
  81.           (if (> (cadr s10) (cadr s11))
  82.             (setq minx-v s11)
  83.             (setq minx-v s10)
  84.           )
  85.           (setvar "osmode" 0)
  86.           (command "_.Move" objx "" miny-h minx-v)
  87.           (setq        vtk    (entget vtk)
  88.                 maxy-h (list (car minx-v)
  89.                              (cadr (cdr (assoc 10 (entget top))))
  90.                        )
  91.                 vtk    (subst (cons 10 minx-v) (assoc 10 vtk) vtk)
  92.                 vtk    (subst (cons 11 maxy-h) (assoc 11 vtk) vtk)
  93.           )
  94.           (entmod vtk)
  95.           (command "_.Move"
  96.                    objx
  97.                    objy
  98.                    ""
  99.                    minx-v
  100.                    (polar minx-v
  101.                           (angle minx-v miny-h)
  102.                           (* 0.5 (distance minx-v miny-h))
  103.                    )
  104.           )
  105.         )
  106.       )
  107.     )
  108.   )
  109.   (setvar "osmode" osm)
  110.   (princ)
  111. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hsb-hy
发表于 2004-7-26 12:25:57 | 显示全部楼层
楼主啊！能否直接做成一个文件让我调用！这样我不会用哦！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

pppk
发表于 2004-7-26 13:10:32 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
程序是不是有问题，不起什么作用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

mmmm
 楼主| 发表于 2004-7-26 14:17:09 | 显示全部楼层
下载文件
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

coolzhb
发表于 2004-7-26 14:44:49 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 mmmm 发布
[B]下载文件 [/B]


楼主太厉害了，这个程序也能想到并利于程序解决它。虽然现在我一般是用其他的二次软件进行EXCEL->CAD，但对于没有软件的朋友还是不错的选择！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

andyhua5240
发表于 2004-7-26 15:45:07 | 显示全部楼层
最初由 mmmm 发布
[B]下载文件 [/B]

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

使用道具 举报

coolzhb
发表于 2004-7-26 16:28:41 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 andyhua5240 发布
[B]
下载用了，楼主的程序很实用也好用，谢谢！
唉，在2004中试了一下，不行，狂晕！ [/B]


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

使用道具 举报

andyhua5240
发表于 2004-7-26 17:07:45 | 显示全部楼层
楼主是不是选择的是AUTOCAD图元呀，我的确实不行！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

coolzhb
发表于 2004-7-26 17:36:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最初由 andyhua5240 发布
[B]楼主是不是选择的是AUTOCAD图元呀，我的确实不行！ [/B]


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

使用道具 举报

andyhua5240
发表于 2004-7-26 18:12:42 | 显示全部楼层
不知道在哪里选呀？
设置了细线也不行呀？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

mmmm
 楼主| 发表于 2004-7-26 20:50:29 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
参考一下我这里写的说明
http://www.xdcad.net/forum/showt ... pagenumber=1&s=
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

andyhua5240
发表于 2004-7-27 10:10:41 | 显示全部楼层
还是不行，试了好多次了，表格细我都选了最细的象虚线的线还是不行！
紧急救助呀！
谢谢！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

mmmm
 楼主| 发表于 2004-7-27 20:02:27 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
你的Excel表格粘贴入AutoCAD后数据类型对吗？
你点取LIST一下，是POLYLINE和TEXT吗？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-27 08:31 , Processed in 0.220724 second(s), 61 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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