超强的批量的“融合线段”工具

brainstorm · 发表于 2017-8-22 09:55:52

增加了对话框，支持量取距离作为融合精度
当直线为水平线时，(XD::Pickset:TableSortAtEcs (cdr x) xdir 0 0 '< '<) 出现除数
为0的错误提示

(defun c:XDTB_LineJoin
(/ ang
dis e
el el1
new old
p1 p2
pts ss
tf x
xdir y
z box
*error*
c:XDTB_LineJoin/Form1/TextButton1#OnClicked
c:XDTB_LineJoin/Form1#OnCancelClose
)
(defun *error* (msg)
(if (dcl-form-isactive xdtb_linejoin_form1)
(dcl-form-close xdtb_linejoin_form1)
)
)
(defun c:XDTB_LineJoin/Form1/TextButton1#OnClicked (/)
(if (setq dis
(getdist
(strcat "\n线合并距离精度<"
(vl-princ-to-string #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
">:"
)
)
)
(setq #XDTB_GLOBAL_VAR_CURVE_SHORTLINE dis)
(setq dis #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
)
(dcl-control-settext
xdtb_linejoin_form1_textbox1
(VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
)
(prompt "\n选择要融合的直线：")
)
(defun c:XDTB_LineJoin/Form1#OnCancelClose (Reason /)
t
)
(if (not #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
(setq #XDTB_GLOBAL_VAR_CURVE_SHORTLINE 0.5)
)
(setq box (last (xdrx_document_pixelbox)))
(command "_opendcl")
(if (not #XDTB_GLOBAL_VAR_odclProject_imported)
(progn
(dcl-project-import
'("YWt6A4YNAAAAlUzZBuKT6LUxLT9quME8V23GbltPD598fThc6ig038ZOOvdPdtw8XHXd/ywCLvQv"
"KhwyJjT8WMSv+1Aix4znhjYizr7z0BqbtEG+Oq/jT0DWGfislwJ0e/PMD+ygRcFHGbDCsEnJFawN"
"FxoAG8MWPXEInnZEDmJXWq7wby2Nf+ZXeDQKOyLVHRY4clMWPu1CeW464cpKXVLLOAeIN5nez0ne"
"IRRPErtenPZ2Obpka6FYz+bfrUTcmM7KOZujWoA/j2FKg5hdFMXwplLT8yytoHfXO1skOqTdLPH1"
"wWHg4BpXCqd+mz1/TDv4V6RbVUT7H3fVIN4cv+wPL3naBdiWXhSiwjIHVa0qrVY8MC9rqCDdx66Z"
"CZIx06OOHZxZuvH2wa8C1OK7htnFMVjYWC2dlNutcCsdnbKWAKFvJnYdkklj0PQdZWhBgm6S2Cvf"
"NSQItODZGsltNjRDV6itLCkZF+qNuhecSbqZ9tFtIVxwhiKANIhPHJuEBfssVU0iuQcspF11ZL3W"
"ErZnB/C0bC31mjJ/KojCxJLAlThrDvxows**CVD/uVdcfc1lrJHmSwwMtFto9bqoU8NZDfXybeN"
"1u3llQvBFWoJ48uhrMKxDCaNACS1RbTPMxqhFccsjWC0m3CcMJwIHIaihwzwEdiLqu5oQ5mKFenh"
"nV+ChI5pDEFXQ5xmbOF/1ly0v4XqDQn3kW+hXzAYKRso3fj2+c3VigOsSax2pzFuMSyCp5JQsI3i"
"i0nFhv+EwTnPvauqgd3j8QAGBEqxjgio6sylRFyRghR0r3f5acHjwZbDjiXbZkXVD3ebZ4ECtCUV"
"JyFjtSicTUXxJ0OxZrNd4SwVF2BHtKNzKcdt5JU2Nz+cU0qADZxim8kUoJbSzU7yBIek1ASViwcC"
"a5D5aOSLdJB5zRXSogI0U4G1NJPZhm26efdtutKKZbr5gJMz3nijj0KTIxDG4BH4PvmC35ZJzLcB"
"VY4BTEHXHZcRzoGMO6tNC5+In0HAcwApg9KIW6oTRjmjmMEi8ETRHmsKyXzjy5zZkY6BUViXOulh"
"dzbaYg=="
)
)
(setq #XDTB_GLOBAL_VAR_odclProject_imported t)
)
)
(dcl-form-show xdtb_linejoin/form1)
(dcl-control-settext
xdtb_linejoin_form1_textbox1
(VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
)
(dcl-form-setpos xdtb_linejoin/form1 (car box) (cadr box))
(prompt "\n选择要融合的直线：")
(while (setq ss (ssget '((0 . "LINE"))))
(progn
(XD::Begin)
(xdrx_sysvar_push "ucsicon" 0)
(if (not (xdrx_document_iswcs))
(progn (setq tf t) (vl-cmdf "ucs" "w"))
)
(if (and
(setq
dis (dcl-control-gettext xdtb_linejoin_form1_textbox1)
)
(not (eq dis ""))
)
(setq dis (atof dis))
(progn
(dcl-control-settext
xdtb_linejoin_form1_textbox1
(VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
)
(setq dis #XDTB_GLOBAL_VAR_CURVE_SHORTLINE)
)
)
(xdrx_document_setprec dis 1)
(xdrx_setsstodb ss 0)
(setq el nil)
(while (setq e (xdrx_getentdata 0))
(setq p1 (xdrx_getpropertyvalue e "StartPoint")
p2 (xdrx_getpropertyvalue e "EndPoint")
ang (angle p1 p2)
ang (XD::Geom:AngleFormat ang)
ang (rtos ang 2 4)
)
(if (setq old (assoc ang el))
(progn (setq new (cons ang (cons e (cdr old))))
(setq el (subst new old el))
)
(progn (setq el (cons (list ang e) el)))
)
)
(setq
el1 (mapcar
'(lambda (x)
(setq xdir (xdrx_vector_Rotate
'(1 0 0)
(atof (car x))
'(0 0 1)
)
)
(XD::Pickset:TableSortAtEcs (cdr x) xdir 0 0 '< '<)
)
el
)
)
(mapcar
'(lambda (x)
(mapcar
'(lambda (y)
(setq p1 (xdrx_getpropertyvalue (car y) "StartPoint")
p2 (xdrx_getpropertyvalue (car y) "EndPoint")
)
(setq
pts (apply
'append
(mapcar
'(lambda (z)
(xdrx_getpropertyvalue z "StretchPoint")
)
y
)
)
)
(setq
pts (mapcar
'car
(xdrx_points_sortOnCurve (list p1 p2) pts t)
)
)
(xdrx_line_make (car pts) (last pts))
(xdrx_entity_setPropertiesFrom (entlast) (car y))
(xdrx_entity_delete y)
)
x
)
)
el1
)
(if tf
(vl-cmdf "ucs" "p")
)
(xdrx_sysvar_pop)
(XD::End)
(prompt "\n选择要融合的直线：")
)
)
(if (dcl-form-isactive xdtb_linejoin_form1)
(dcl-form-close xdtb_linejoin_form1)
)
(princ)
)

(defun c:XDTB_LineJoin 
                       (/                   ang 
                        dis                   e 
                        el                   el1 
                        new                   old 
                        p1                   p2 
                        pts                   ss 
                        tf                   x 
                        xdir                   y 
                        z                   box 
                        *error* 
                        c:XDTB_LineJoin/Form1/TextButton1#OnClicked 
                        c:XDTB_LineJoin/Form1#OnCancelClose 
                       ) 
 
 
  (defun *error* (msg) 
    (if        (dcl-form-isactive xdtb_linejoin_form1) 
      (dcl-form-close xdtb_linejoin_form1) 
    ) 
  ) 
  (defun c:XDTB_LineJoin/Form1/TextButton1#OnClicked (/) 
    (if        (setq dis 
               (getdist 
                 (strcat "\n线合并距离精度<" 
                         (vl-princ-to-string #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
                         ">:" 
                 ) 
               ) 
        ) 
      (setq #XDTB_GLOBAL_VAR_CURVE_SHORTLINE dis) 
      (setq dis #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
    ) 
    (dcl-control-settext 
      xdtb_linejoin_form1_textbox1 
      (VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
    ) 
    (prompt "\n选择要融合的直线：") 
  ) 
  (defun c:XDTB_LineJoin/Form1#OnCancelClose (Reason /) 
    t 
  ) 
 
 
 
  (if (not #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
    (setq #XDTB_GLOBAL_VAR_CURVE_SHORTLINE 0.5) 
  ) 
  (setq box (last (xdrx_document_pixelbox))) 
 
 
 
  (command "_opendcl") 
  (if (not #XDTB_GLOBAL_VAR_odclProject_imported) 
    (progn 
      (dcl-project-import 
        '("YWt6A4YNAAAAlUzZBuKT6LUxLT9quME8V23GbltPD598fThc6ig038ZOOvdPdtw8XHXd/ywCLvQv" 
          "KhwyJjT8WMSv+1Aix4znhjYizr7z0BqbtEG+Oq/jT0DWGfislwJ0e/PMD+ygRcFHGbDCsEnJFawN" 
          "FxoAG8MWPXEInnZEDmJXWq7wby2Nf+ZXeDQKOyLVHRY4clMWPu1CeW464cpKXVLLOAeIN5nez0ne" 
          "IRRPErtenPZ2Obpka6FYz+bfrUTcmM7KOZujWoA/j2FKg5hdFMXwplLT8yytoHfXO1skOqTdLPH1" 
          "wWHg4BpXCqd+mz1/TDv4V6RbVUT7H3fVIN4cv+wPL3naBdiWXhSiwjIHVa0qrVY8MC9rqCDdx66Z" 
          "CZIx06OOHZxZuvH2wa8C1OK7htnFMVjYWC2dlNutcCsdnbKWAKFvJnYdkklj0PQdZWhBgm6S2Cvf" 
          "NSQItODZGsltNjRDV6itLCkZF+qNuhecSbqZ9tFtIVxwhiKANIhPHJuEBfssVU0iuQcspF11ZL3W" 
          "ErZnB/C0bC31mjJ/KojCxJLAlThrDvxows**CVD/uVdcfc1lrJHmSwwMtFto9bqoU8NZDfXybeN" 
          "1u3llQvBFWoJ48uhrMKxDCaNACS1RbTPMxqhFccsjWC0m3CcMJwIHIaihwzwEdiLqu5oQ5mKFenh" 
          "nV+ChI5pDEFXQ5xmbOF/1ly0v4XqDQn3kW+hXzAYKRso3fj2+c3VigOsSax2pzFuMSyCp5JQsI3i" 
          "i0nFhv+EwTnPvauqgd3j8QAGBEqxjgio6sylRFyRghR0r3f5acHjwZbDjiXbZkXVD3ebZ4ECtCUV" 
          "JyFjtSicTUXxJ0OxZrNd4SwVF2BHtKNzKcdt5JU2Nz+cU0qADZxim8kUoJbSzU7yBIek1ASViwcC" 
          "a5D5aOSLdJB5zRXSogI0U4G1NJPZhm26efdtutKKZbr5gJMz3nijj0KTIxDG4BH4PvmC35ZJzLcB" 
          "VY4BTEHXHZcRzoGMO6tNC5+In0HAcwApg9KIW6oTRjmjmMEi8ETRHmsKyXzjy5zZkY6BUViXOulh" 
          "dzbaYg==" 
         ) 
      ) 
      (setq #XDTB_GLOBAL_VAR_odclProject_imported t) 
    ) 
  ) 
  (dcl-form-show xdtb_linejoin/form1) 
  (dcl-control-settext 
    xdtb_linejoin_form1_textbox1 
    (VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
  ) 
  (dcl-form-setpos xdtb_linejoin/form1 (car box) (cadr box)) 
 
 
  (prompt "\n选择要融合的直线：") 
  (while (setq ss (ssget '((0 . "LINE")))) 
    (progn 
      (XD::Begin) 
      (xdrx_sysvar_push "ucsicon" 0) 
      (if (not (xdrx_document_iswcs)) 
        (progn (setq tf t) (vl-cmdf "ucs" "w")) 
      ) 
 
      (if (and 
            (setq 
              dis (dcl-control-gettext xdtb_linejoin_form1_textbox1) 
            ) 
            (not (eq dis "")) 
          ) 
        (setq dis (atof dis)) 
        (progn 
          (dcl-control-settext 
            xdtb_linejoin_form1_textbox1 
            (VL-PRINC-TO-STRING #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
          ) 
          (setq dis #XDTB_GLOBAL_VAR_CURVE_SHORTLINE) 
        ) 
      ) 
 
      (xdrx_document_setprec dis 1) 
      (xdrx_setsstodb ss 0) 
      (setq el nil) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq p1  (xdrx_getpropertyvalue e "StartPoint") 
              p2  (xdrx_getpropertyvalue e "EndPoint") 
              ang (angle p1 p2) 
              ang (XD::Geom:AngleFormat ang) 
              ang (rtos ang 2 4) 
        ) 
        (if (setq old (assoc ang el)) 
          (progn (setq new (cons ang (cons e (cdr old)))) 
                 (setq el (subst new old el)) 
          ) 
          (progn (setq el (cons (list ang e) el))) 
        ) 
      ) 
      (setq 
        el1 (mapcar 
              '(lambda (x) 
                 (setq xdir (xdrx_vector_Rotate 
                              '(1 0 0) 
                              (atof (car x)) 
                              '(0 0 1) 
                            ) 
                 ) 
                 (XD::Pickset:TableSortAtEcs (cdr x) xdir 0 0 '< '<) 
               ) 
              el 
            ) 
      ) 
      (mapcar 
        '(lambda (x) 
           (mapcar 
             '(lambda (y) 
                (setq p1 (xdrx_getpropertyvalue (car y) "StartPoint") 
                      p2 (xdrx_getpropertyvalue (car y) "EndPoint") 
                ) 
                (setq 
                  pts (apply 
                        'append 
                        (mapcar 
                          '(lambda (z) 
                             (xdrx_getpropertyvalue z "StretchPoint") 
                           ) 
                          y 
                        ) 
                      ) 
                ) 
                (setq 
                  pts (mapcar 
                        'car 
                        (xdrx_points_sortOnCurve (list p1 p2) pts t) 
                      ) 
                ) 
                (xdrx_line_make (car pts) (last pts)) 
                (xdrx_entity_setPropertiesFrom (entlast) (car y)) 
                (xdrx_entity_delete y) 
              ) 
             x 
           ) 
         ) 
        el1 
      ) 
      (if tf 
        (vl-cmdf "ucs" "p") 
      ) 
      (xdrx_sysvar_pop) 
      (XD::End) 
      (prompt "\n选择要融合的直线：") 
    ) 
  ) 
  (if (dcl-form-isactive xdtb_linejoin_form1) 
    (dcl-form-close xdtb_linejoin_form1) 
  ) 
  (princ) 
)

cshimao · 发表于 2017-8-22 10:50:23

感觉很好，看看实用不？

lzy1979 · 发表于 2017-8-23 08:51:21

kanzhebucxuod eixeix e

wangqxd · 发表于 2017-8-23 16:48:05

我也来学习学习怎么用呢？

libiao0902 · 发表于 2017-8-23 23:33:08

看看，，，，，，

wu54210 · 发表于 2017-9-2 00:46:39

好用，谢谢

wu54210 · 发表于 2017-9-2 00:47:40

好用，谢谢

liulisheng · 发表于 2017-9-2 14:23:05

xingyundoudou · 发表于 2017-9-3 16:16:38

sdfdsfdsfsdf

xgr669 · 发表于 2017-9-20 14:20:26

超强的批量的“融合线段”工具

xzxw2015001 · 发表于 2017-9-23 17:02:52

学习一下谢谢啦!!!!!

PO0O0 · 发表于 2017-9-24 16:38:32

我看看是否用得上

DOUTING · 发表于 2017-9-28 17:35:09

不知道怎么下载，怎么编辑

ll098 · 发表于 2017-9-29 13:59:27

好东西啊，谢谢楼主分享

abenmao168 · 发表于 2017-9-30 01:02:08

好资源，感谢分享

账号		自动登录	找回密码
密码			立即注册

[曲线] 超强的批量的“融合线段”工具