线合并(lsp源程序)...

qjcpj

仿AutoCAD 2006的jion命令所写的一个lsp程序，目前仅支持“直线”合并，适用于2000及以上版本，程序没有容错处理，其他如圆弧，椭圆弧及样条曲线的合并大家可自行添加。欢迎各位初学者试用，并多提意见。
编写该程序的初衷是我很需要该功能，但我的机子运行AutoCAD 2006实在是太慢了！
该程序的表排序部分借用了舟自横的子表排序思路，在此一并感谢。

snoopychen

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]

qjcpj

添加了对ARC实体的支持。
注：加载程序后在命令行输入combine执行程序。

mlq9928

呵呵，谢谢，正在找多条线的连接。。join只能连接两条直线

szx025

能否连多义线

pdesign

好好.試試看

shijiaoxiong

不错啊、

yxb345

好东西，收集中

redawater

还真有用，收下了，以后省事了

yoyoho

3楼程序无法下
不知什么缘故

leeyuan

晓东的下载，成功的次数越来越少了，建议升级下机站

zxmn551315

是的，有了连接程序是不是还有打断程序，然后自动用弧线连接起来

killer9806

多线段联结很好用,谢谢

jactry

支持

carrot1983

qjchen 很牛的说。
非常好用的多个线段连接。