共线直线并批量连接-------多段线连接-------Join

自贡黄明儒

自从AutoCAD使用"打断br"以来,就一直没有其逆操作Join。直到前几天,我试用2012版，发现Autocad已经翻然醒悟，Join出现了。
其实明经的网友们早就写了该程序，但写得复杂，我一直没有读懂。下面是我写的，写得很简单。经试试用，比2012版中的join要好用得多。
牛皮吹完了，不信你可以试一试。
;;;;;  共线直线并批量连接,相当于命令Join
  (defun C:JOIN (/ E E1 EN EN1 I N ssLine)
    ;;1  p1是否在p2 p3线上,返回0.0
    ;;p1 is a point
    ;;p2 and p3 are points that form a line segment
    ;;returns  1 is p1 is on one side
    ;;        -1 if on the other side
    ;;         0 if on the line
    (defun what_side (p1 p2 p3 / a dx dx1 dy dy1)
      (setq dx (- (car p3) (car p2))
     dy (- (cadr p3) (cadr p2))
     dx1 (- (car p1) (car p2))
     dy1 (- (cadr p1) (cadr p2))
      )     ;setq
      (setq a (- (* dx dy1) (* dy dx1))
     a (rtos a 2 6)
     a (atof a)
      )     ;setq
      (if (not (equal 0.0 a))
(setq a (/ a (abs a)))  ;setq
      )     ;if
      a
    )     ;defun what_side
    ;;2 p1是否在p2 p3之间
    (defun Between (p1 p2 p3)
      (equal (+ (distance p1 p2) (distance p1 p3))
      (distance p2 p3)
      0.01
      )
    )
    ;;3 点表排序
    (defun Sort_XYZ_pList (PLIST / p1 p2)
      (setq plist (vl-sort plist
      '(lambda (p1 p2)
         (cond ((< (car p1) (car p2)) T)
        ((and (= (car p1) (car p2))
       (< (cadr p1) (cadr p2))
         )
         T
        )
        ((and (= (car p1) (car p2))
       (= (cadr p1) (cadr p2))
       (< (caddr p1) (caddr p2))
         )
         T
        )
        (T nil)
         )
       )
    )
      )
    )
    ;;4 与一条直线相连的所有直线  
    (defun joinLine (e e1 / EN EN1 P1 P2 P3 P4 PLIST)
      (setq en (entget e))
      (setq p1 (LI_item 10 en))
      (setq p2 (LI_item 11 en))
      (setq en1 (entget e1))
      (setq p3 (LI_item 10 en1))
      (setq p4 (LI_item 11 en1))
      (if (and (equal (what_side p3 p1 p2) 0.0)
        (equal (what_side p4 p1 p2) 0.0)
        (or (Between p3 p1 p2) (Between p4 p1 p2));对pdf转换成的dwg,不要这句更妥
   )
(progn
   (setq Plist (Sort_XYZ_pList (list p1 p2 p3 p4)))
   (setq p1 (car Plist))
   (setq p2 (car (reverse Plist)))
   (setq en (subst (cons 10 p1) (assoc 10 en) en))
   (entmod (subst (cons 11 p2) (assoc 11 en) en))
   (command "_.erase" e1 "")
)
      )
    )
    ;;5 本程序主程序
    (setq ssLine (ssget '((0 . "LINE"))))
    (repeat (setq n (sslength ssLine))
      (if (and (setq e (ssname ssLine (setq n (1- n))))
        (setq en (entget e))
   )
(repeat (setq i n)
   (if (and (setq e1 (ssname ssLine (setq i (1- i))))
     (setq en1 (entget e1))
       )
     (joinLine e e1)
   )
)
      )
    )
    (princ "\n written by 自贡黄明儒 命令:Join")
    (princ)
  )

自贡黄明儒

(defun hh:ELg (/ PET SS1 ss)
  (setq ss (ssget '((0 . "ARC,*LINE"))))
  (setq pet (getvar "PEDITACCEPT"))
  (setvar "PEDITACCEPT" 1)
  (command "select" ss "")
  (while (setq ss1 (ssget "_p" '((0 . "ARC,*LINE"))))
    (command "_pedit" (ssname ss1 0) "j" ss1 "" "")
  )
  (setvar "PEDITACCEPT" pet)
  (princ "\n*   圆、线、弧已经转成多段线   *\n")
)

w245272914

錯誤: no function definition: LI_ITEM    大神这是怎么回事啊~~~   求修改，我是2007

zyhandw

只对line直线起作用！是否考虑一下针对多段线也写一个？

print1985

支持啊 要是多段线也行就更好了
我相信楼主完全可以办到 顶楼主

【KAIXIN】

缺少函数：LI_item

是提取对应组码值的通用函数？

tm20038175

好程序，支持！……

自贡黄明儒

【KAIXIN】 发表于 2012-6-8 10:46
缺少函数：LI_item

是提取对应组码值的通用函数？

(Defun LI_item (N E) (CDR (Assoc N E)))

429014673

弧线行不？？？

xingyun300

两条直线只能点选，不能框选呀！改为框选就好了！！！！！！

psdcdr

好程序，能不能添加框选？

xingyun300

xingyun300 发表于 2012-6-8 15:46
两条直线只能点选，不能框选呀！改为框选就好了！！！！！！

框选不会用，只能点选呀，能不能执行命令后就能框选呢？？？？？