设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 4087|回复: 32

[源码] 线合并(lsp源程序)...

[复制链接]
发表于 2005-9-28 16:39:33 | 显示全部楼层 |阅读模式

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

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

x
本帖最后由 yularna 于 2015-2-10 20:43 编辑

仿AutoCAD 2006的jion命令所写的一个lsp程序,目前仅支持“直线”合并,适用于2000及以上版本,程序没有容错处理,其他如圆弧,椭圆弧及样条曲线的合并大家可自行添加。欢迎各位初学者试用,并多提意见。
编写该程序的初衷是我很需要该功能,但我的机子运行AutoCAD 2006实在是太慢了!
该程序的表排序部分借用了舟自横的子表排序思路,在此一并感谢。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2005-9-28 20:50:20 | 显示全部楼层
cpj兄程序挺好的。
我也献丑一个,三年前编的一个连接程序,也是用于连接直线的,不过我一般是拿来连接梁线的,因此需要多选,让同个方向上共线的直线合并。
程序结构乱七八糟的,现在看起来都郁闷,不过也懒得去重新修整程序了。:)
[php]
;;by qjchen at xdcad

(defun kandb (hnd1)
  (setq ent1 (entget hnd1))
  (setq obj1 (cdr (assoc 0 ent1)))
    (if (= obj1 "LINE")
  (progn  
    (setq pointa (cdr (assoc 10 ent1))
        pointb (cdr (assoc 11 ent1)))
    (setq xa (car pointa))
    (setq xb (car pointb))
    (setq ya (cadr pointa))
    (setq yb (cadr pointb))
    (if (/= xa xb)
    (progn
    (setq kab (/ (- yb ya) (- xb xa)))
    (if (< (abs kab) 0.001) (setq kab 0))  
    (if (> (abs kab) 7e+9) (setq kab "infinite"))
    (setq bab (/ (- (* xb ya) (* xa yb)) (- xb xa)))  
     ))
    (if (= xa xb)
    (setq kab "infinite" bab "unexist")
     )
     ))
)
;×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
;主程序开始了

(defun c:x( / ent1 obj1 pointa pointb xa xb ya yb kab bab sset1 ii num1 hnd0 ent000 layobj colorobj ltypeobj k12 hnd1 ent111 x1 y1 x2 y2 k12  b12  xmin  ymin  xmax  ymax  jj  pointmax  pointmin  hnd2  ent222  mm  x3  y3  x4  y4  k34  b34  x5  y5  k1234  b1234  qq  hnd2  ent222  x34  x34min )
  
   (setq cm  (getvar "cmdecho"))
   (setq os  (getvar "osmode"))
   (setq bl  (getvar "blipmode"))
   (setq regmode  (getvar "regenmode"))
   (setq layernow (getvar "clayer"))
   (setq colornow (getvar "cecolor"))
   (setq ltypenow (getvar "celtype"))
   (command "undo" "be")
   (setvar "osmode" 0)
   ;(setvar "regenmode" 1)
   ;(setvar "cmdecho" 1)
   (setq sset1 (ssget '((0 . "LINE"))))
   (setq i 0)
   (while (< i (sslength sset1))
     (setq lyname nil)
     (setq sat nil)
     (setq lyname (cdr (assoc 8 (entget (ssname sset1 i)))))
     (setq sat(cdr (assoc 70 (tblsearch "layer" lyname))))
     (if (eq 68 sat)
       (progn
         (ssdel (ssname sset1 i) sset1)
         (setq i (- i 1))
       )
     )
     (setq i (1+ i))
   )               
   
   (setq ii 0
        num1 (sslength sset1)
    )
   
   
    ;从第一个进行开始搜索
    ;大循环aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
    (setq hnd0 (ssname sset1 0))
      (setq ent000 (entget hnd0))
      (setq layerobj (cdr (assoc 8 ent000)))
      (setq colorobj (cdr (assoc 62 ent000)))
      (setq ltypeobj (cdr (assoc 6 ent000)))
      (if (= colorobj nil) (setq colorobj "bylayer" ))
      (if (= ltypeobj nil) (setq ltypeobj "bylayer" ))
      
            
      (command "layer" "s" layerobj "")
      (command "color" colorobj )
      ;(command "linetype" "s" ltypeobj "")
      
   
   (while (< ii (- num1 1))
      (setq k12 0)
      (setq hnd1 (ssname sset1 ii))
      (setq ent111 (entget hnd1))
      
      ;-------------------------------------------------------
      (if ent111 (progn
        (kandb hnd1)
        
        ;(command "change" hnd1 "" "p" "color" 1 "")
        ;(redraw hnd1 3)
       (setq x1 xa y1 ya x2 xb y2 yb k12 kab b12 bab)
      
      
       ;----star not infinite---------------------------------
       (if (/= k12 "infinite")
       (progn
       (setvar "osmode" 0)
      
       (if (<= x1 x2)
       (setq xmin x1 ymin y1 xmax x2 ymax y2))
       (if (> x1 x2)
       (setq xmin x2 ymin y2 xmax x1 ymax y1))
       ;(entdel hnd1)
       (setq jj (1+ ii ))
       (setq pointmin nil)
       (setq pointmax nil)      
          ;小循环bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
              (while (< jj num1)
              
                  (setq hnd2 (ssname sset1 jj))
            (setq ent222 (entget hnd2))
            ;-------------------------------------------------
                   (if ent222 (progn
                (kandb hnd2)
                    (setq mm (+ ii 3))
                     ;(command "change" hnd2 "" "p" "color" mm "")
                    (setq x3 xa y3 ya x4 xb y4 yb k34 kab b34 bab)

                    
                       ;---------------------------------------------
                    (if (> x3 x4)
                        (progn
                        ;(princ "heihei")
                        (setq x5 x3 y5 y3)
                            (setq x3 x4 y3 y4)
                        (setq x4 x5 y4 y5)
                ))
                       ;---------------------------------------------
                       (setq k1234 nil)
                      (setq b1234 nil)
               (if (/= k34 "infinite")
               (progn
               (setq k1234 (abs(- k12 k34)))
               (setq b1234 (abs(- b12 b34)))))
                       ;---------------------------------------------
               (if (and b1234 (< k1234 0.0001))
               (progn
                   ;------------------------------------------
                   (if (< b1234 0.0001)
                           (progn
                           (setq qq (- x3 xmin))
                           ;--------------------------------------
                           (if (< qq 0)
                           (progn
                              (setq xmin x3)
                              (setq ymin y3)
                             
                           ))
                           ;--------------------------------------
                          (if (> x4 xmax) (setq xmax x4 ymax y4))
                         
                           (command "erase" hnd2 "")
                       ))
                      ;------------------------------------------
                   ))
                   ;---------------------------------------------
             ))  
             ;---------------------------------------------------
            (setq jj (1+ jj))
        (setq pointmin (list xmin ymin))
           (setq pointmax (list xmax ymax))
      )
      ;小循环bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb

        (command "erase" hnd1 "")
            


            (command "line" pointmin pointmax "")
            (setvar "osmode"  os)
           
     ))
     ;----------end not infinite-----------------------------
     
     
     
     (if (= k12 "infinite" )
  
       (progn
       (setvar "osmode" 0)
       (if (<= y1 y2)
       (setq xmin x1 ymin y1 xmax x2 ymax y2))
      
       (if (> y1 y2)
       (setq xmin x2 ymin y2 xmax x1 ymax y1))
      
       ;(entdel hnd1)
       (setq jj (1+ ii ))
          ;小循环bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
              (while (< jj num1)
              
                  (setq hnd2 (ssname sset1 jj))
            (setq ent222 (entget hnd2))
            
            ;-------------------------------------------------
                   (if ent222 (progn
                (kandb hnd2)
                    (setq mm (+ ii 3))
                    ; (command "change" hnd2 "" "p" "color" mm "")
                    (setq x3 xa y3 ya x4 xb y4 yb k34 kab b34 bab)
                       ;---------------------------------------------
                    (if (> y3 y4)
                        (progn
                        ;(princ "heihei")
                        (setq x5 x3 y5 y3)
                            (setq x3 x4 y3 y4)
                        (setq x4 x5 y4 y5)
                ))
               
                       ;---------------------------------------------
               (setq k1234 k34)
               
               (setq x34 x3)
               (setq x34min (abs(- x34 xmin)))
               
               
                       ;---------------------------------------------
               (if (= k1234 "infinite")

               
               (progn
                   ;------------------------------------------
                   (if (< x34min 0.0001)

                  
                           (progn
                           (setq qq (- y3 ymin))
                           ;--------------------------------------
                          
                           (if (< qq 0)
                           (progn
                              (setq xmin x3)
                              (setq ymin y3)
                           ))
                           ;--------------------------------------
                          (if (> y4 ymax) (setq xmax x4 ymax y4))
                           (command "erase" hnd2 "")
                       ))
                      ;------------------------------------------
                   ))
                   ;---------------------------------------------
             ))  
             ;---------------------------------------------------
            (setq jj (1+ jj))
        (setq pointmin (list xmin ymin))
           (setq pointmax (list xmax ymax))
      )
      ;小循环bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb

        (command "erase" hnd1 "")
        
        ;(princ "准备画线了" )
        
            (command "line" pointmin pointmax "")
            (setvar "osmode"  os)
           
           
     ))
;     ;-------------------------------------------------------
     )
     (setq ii (1+ ii))
   )
   ;结束大循环aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
)   
;(setvar "regenmode" pl)
  ;(setvar "cmdecho" cm)
  
  (setvar "osmode"  os)
  ;(setvar "blipmode" bl)
  (command "layer" "s" layernow "")
  (command "color" colornow )
  (command "-linetype" "s" ltypenow "")
  (command "undo" "e")

)

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

使用道具 举报

 楼主| 发表于 2005-10-17 18:09:12 | 显示全部楼层
添加了对ARC实体的支持。
注:加载程序后在命令行输入combine执行程序。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-6-16 16:40:02 | 显示全部楼层
呵呵,谢谢,正在找多条线的连接。。join只能连接两条直线
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 7594个

财富等级: 富甲天下

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

使用道具 举报

发表于 2009-5-6 14:41:01 | 显示全部楼层
晓东的下载,成功的次数越来越少了,建议升级下机站
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2009-6-6 17:42:54 | 显示全部楼层
是的,有了连接程序是不是还有打断程序,然后自动用弧线连接起来
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2020-11-30 19:44 , Processed in 0.129768 second(s), 94 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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