块与块连线程序求助

grs432 · 发表于 2014-11-25 14:25:56

st788796 发表于 2014-11-25 12:33
绘制过程有选取块功能，顶点数就是块数量，可以将块名记录到组内的，可以最后有个判断是否选择上了块而且 ...

对了，成组后，要向里面加入线的话，是不是也需要个程序！
减点的程序已在上边发了，测试过了，没有问题！{:soso_e113:}

st788796 · 发表于 2014-11-25 14:34:39

grs432 发表于 2014-11-25 14:25
对了，成组后，要向里面加入线的话，是不是也需要个程序！
减点的程序已在上边发了，测试过了，没有问题 ...

加点可以和减点合成一个程序，就是多义线增删顶点，只不过增加一步计算凸度

st788796 · 发表于 2014-11-25 14:35:41

grs432 发表于 2014-11-25 14:25
对了，成组后，要向里面加入线的话，是不是也需要个程序！
减点的程序已在上边发了，测试过了，没有问题 ...

加点可以和减点合成一个程序，实质多义线增删顶点，只不过增加一步计算特殊凸度

grs432 · 发表于 2014-11-26 17:49:37

st788796 发表于 2014-11-25 14:35
加点可以和减点合成一个程序，实质多义线增删顶点，只不过增加一步计算特殊凸度

挺期待您的程序的，想试试。导入EXCEL表格中应该不会很难吧！！！

st788796 · 发表于 2014-11-26 18:00:27

grs432 发表于 2014-11-26 17:49
挺期待您的程序的，想试试。导入EXCEL表格中应该不会很难吧！！！

用XDGE解析库几句话而已，也有封装的lisp函数

grs432 · 发表于 2014-11-26 20:26:57

st788796 发表于 2014-11-26 18:00
用XDGE解析库几句话而已，也有封装的lisp函数

哦，我还是不太懂怎么用，只能期待您帮忙写的程序试试了！{:soso_e144:}

st788796 · 发表于 2014-11-27 18:29:30

grs432 发表于 2014-11-26 20:26
哦，我还是不太懂怎么用，只能期待您帮忙写的程序试试了！

http://bbs.xdcad.net/thread-677386-1-1.html

试试这个绘制，如果运行正确给录个动画吧

grs432 · 发表于 2014-11-27 23:33:12

本帖最后由 grs432 于 2014-11-27 23:37 编辑

st788796 发表于 2014-11-27 18:29
http://bbs.xdcad.net/thread-677386-1-1.html

试试这个绘制，如果运行正确给录个动画吧

OK，程序试过了，以前我就了你演示的动画，我以为不太合适，但是一试才发现不一样了，现在但是还是没有取块名到组内的。。能在最后加入命令取一下回路线上的块吗？

如果能将上图中的块名加入到组中就好了。
还有就是差增加回路的方式，开组---点以前线自动连续加线---关组。
下面我附了1个图

st788796 · 发表于 2014-11-28 14:22:31

grs432 发表于 2014-11-27 23:33
OK，程序试过了，以前我就了你演示的动画，我以为不太合适，但是一试才发现不一样了，现在但是还是没有取 ...

增删顶点

(defun c:tt (/ _removevertexat _addvertexat e tf p key pr)
(defun _removevertexat (e p / n bulge p p1 p2 d)
(setq n (fix (xdrx_curve_getparamatpoint e p)))
(cond
((zerop n)
(xdrx_polyline_removevertexat e 0)
)
((= n (1- (xdrx_polyline_numverts e)))
(xdrx_polyline_removevertexat e (1- n))
)
(t
(setq bulge (xdrx_polyline_getbulgeat e n)
p (xdrx_curve_getpointatparam e (+ n 0.5))
p1 (xdrx_polyline_getpointat e (1- n))
p2 (xdrx_polyline_getpointat e (1+ n))
d (distance
p
(xdrx_line_midp
(xdrx_polyline_getpointat e n)
p2
)
)
)
(xdrx_polyline_removevertexat e n)
(xdrx_polyline_setbulgeat
e
(1- n)
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p1 p2)))
(/ (* 2.0 d) (distance p1 p2))
)
)
)
)
)
(defun _addvertexat (e p / n p1 p2 pm d bulge p0)
(setq p0 (xdrx_curve_getclosestpoint e p)
n (fix (xdrx_curve_getparamatpoint e p0))
)
(cond
((zerop n)
(setq p1 (xdrx_curve_getstartpoint e)
p2 (xdrx_curve_getpointatparam e 1.0)
pm (xdrx_curve_getpointatparam e 0.5)
d (distance pm (xdrx_line_midp p1 p2))
bulge (xdrx_polyline_getbulgeat e 0)
)
(xdrx_polyline_setpointat e 0 p)
(xdrx_polyline_addvertexat e 0 p1)
(xdrx_polyline_setbulgeat
e
0
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p1)))
(/ (* 2.0 d) (distance p p1))
)
)
(xdrx_polyline_setbulgeat
e
1
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p2)))
(/ (* 2.0 d) (distance p p2))
)
)
)
((= n (1- (xdrx_polyline_numverts e)))
(setq p1 (xdrx_curve_getendpoint e)
p2 (xdrx_curve_getpointatparam e (1- n))
pm (xdrx_curve_getpointatparam e (- n 0.5))
d (distance pm (xdrx_line_midp p1 p2))
bulge (xdrx_polyline_getbulgeat e 0)
)
(xdrx_polyline_setpointat e (1- n) p)
(xdrx_polyline_addvertexat e (- n 2) p1)
(xdrx_polyline_setbulgeat
e
(1- n)
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p1)))
(/ (* 2.0 d) (distance p p1))
)
)
(xdrx_polyline_setbulgeat
e
n
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p2)))
(/ (* 2.0 d) (distance p p2))
)
)
)
(t
(setq p1 (xdrx_polyline_getpointat e n)
p2 (xdrx_polyline_getpointat e (1+ n))
pm (xdrx_curve_getpointatparam e (+ n 0.5))
d (distance pm (xdrx_line_midp p1 p2))
bulge (xdrx_polyline_getbulgeat e n)
)
(xdrx_polyline_addvertexat e (1+ n) p)
(xdrx_polyline_setbulgeat
e
n
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p1)))
(/ (* 2.0 d) (distance p p1))
)
)
(xdrx_polyline_setbulgeat
e
(1+ n)
(if (minusp bulge)
(- (/ (* 2.0 d) (distance p p2)))
(/ (* 2.0 d) (distance p p2))
)
)
)
)
)
;;main program
(if (setq e (car (xdrx_entsel "\n选择回路线: " '((0 . "lwpolyline")))))
(progn
(setq tf t
key "D"
pr "\r"
)
(while tf
(initget 128 "A D")
(setq p
(getpoint (strcat pr "拾取点[删点(D)/增点(A)]<" key ">: "))
)
(cond
((and (not (null p)) (listp p))
(if (= key "D")
(_removevertexat e p)
(_addvertexat e p)
)
(setq pr "\r")
)
((= p "A") (setq key "A") (setq pr "\n"))
((= p "D") (setq key "D") (setq pr "\n"))
(t (setq tf nil))
)
)
)
)
(princ)
)

(defun c:tt (/ _removevertexat _addvertexat e tf p key pr) 
  (defun _removevertexat (e p / n bulge p p1 p2 d) 
    (setq n (fix (xdrx_curve_getparamatpoint e p))) 
    (cond 
      ((zerop n) 
       (xdrx_polyline_removevertexat e 0) 
      ) 
      ((= n (1- (xdrx_polyline_numverts e))) 
       (xdrx_polyline_removevertexat e (1- n)) 
      ) 
      (t 
       (setq bulge (xdrx_polyline_getbulgeat e n) 
             p           (xdrx_curve_getpointatparam e (+ n 0.5)) 
             p1           (xdrx_polyline_getpointat e (1- n)) 
             p2           (xdrx_polyline_getpointat e (1+ n)) 
             d           (distance 
                     p 
                     (xdrx_line_midp 
                       (xdrx_polyline_getpointat e n) 
                       p2 
                     ) 
                   ) 
       ) 
       (xdrx_polyline_removevertexat e n) 
       (xdrx_polyline_setbulgeat 
         e 
         (1- n) 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p1 p2))) 
           (/ (* 2.0 d) (distance p1 p2)) 
         ) 
       ) 
      ) 
    ) 
  ) 
  (defun _addvertexat (e p / n p1 p2 pm d bulge p0) 
    (setq p0 (xdrx_curve_getclosestpoint e p) 
          n  (fix (xdrx_curve_getparamatpoint e p0)) 
    ) 
    (cond 
      ((zerop n) 
       (setq p1           (xdrx_curve_getstartpoint e) 
             p2           (xdrx_curve_getpointatparam e 1.0) 
             pm           (xdrx_curve_getpointatparam e 0.5) 
             d           (distance pm (xdrx_line_midp p1 p2)) 
             bulge (xdrx_polyline_getbulgeat e 0) 
       ) 
       (xdrx_polyline_setpointat e 0 p) 
       (xdrx_polyline_addvertexat e 0 p1) 
       (xdrx_polyline_setbulgeat 
         e 
         0 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p1))) 
           (/ (* 2.0 d) (distance p p1)) 
         ) 
       ) 
       (xdrx_polyline_setbulgeat 
         e 
         1 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p2))) 
           (/ (* 2.0 d) (distance p p2)) 
         ) 
       ) 
      ) 
      ((= n (1- (xdrx_polyline_numverts e))) 
       (setq p1           (xdrx_curve_getendpoint e) 
             p2           (xdrx_curve_getpointatparam e (1- n)) 
             pm           (xdrx_curve_getpointatparam e (- n 0.5)) 
             d           (distance pm (xdrx_line_midp p1 p2)) 
             bulge (xdrx_polyline_getbulgeat e 0) 
       ) 
       (xdrx_polyline_setpointat e (1- n) p) 
       (xdrx_polyline_addvertexat e (- n 2) p1) 
       (xdrx_polyline_setbulgeat 
         e 
         (1- n) 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p1))) 
           (/ (* 2.0 d) (distance p p1)) 
         ) 
       ) 
       (xdrx_polyline_setbulgeat 
         e 
         n 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p2))) 
           (/ (* 2.0 d) (distance p p2)) 
         ) 
       ) 
      ) 
      (t 
       (setq p1           (xdrx_polyline_getpointat e n) 
             p2           (xdrx_polyline_getpointat e (1+ n)) 
             pm           (xdrx_curve_getpointatparam e (+ n 0.5)) 
             d           (distance pm (xdrx_line_midp p1 p2)) 
             bulge (xdrx_polyline_getbulgeat e n) 
       ) 
       (xdrx_polyline_addvertexat e (1+ n) p) 
       (xdrx_polyline_setbulgeat 
         e 
         n 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p1))) 
           (/ (* 2.0 d) (distance p p1)) 
         ) 
       ) 
       (xdrx_polyline_setbulgeat 
         e 
         (1+ n) 
         (if (minusp bulge) 
           (- (/ (* 2.0 d) (distance p p2))) 
           (/ (* 2.0 d) (distance p p2)) 
         ) 
       ) 
      ) 
    ) 
  ) 
  ;;main program 
  (if (setq e (car (xdrx_entsel "\n选择回路线: " '((0 . "lwpolyline"))))) 
    (progn 
      (setq tf        t 
            key        "D" 
            pr        "\r" 
      ) 
      (while tf 
        (initget 128 "A D") 
        (setq p 
               (getpoint (strcat pr "拾取点[删点(D)/增点(A)]<" key ">: ")) 
        ) 
        (cond 
          ((and (not (null p)) (listp p)) 
           (if (= key "D") 
             (_removevertexat e p) 
             (_addvertexat e p) 
           ) 
           (setq pr "\r") 
          ) 
          ((= p "A") (setq key "A") (setq pr "\n")) 
          ((= p "D") (setq key "D") (setq pr "\n")) 
          (t (setq tf nil)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-11-28 14:42:51

grs432 发表于 2014-11-27 23:33
OK，程序试过了，以前我就了你演示的动画，我以为不太合适，但是一试才发现不一样了，现在但是还是没有取 ...

http://bbs.xdcad.net/thread-677386-1-1.html

更新，将块名记录在文字的扩展记录中

st788796 · 发表于 2014-11-28 14:52:36

处理旧图，Pline 顶点数为经过的图块数量（组内仅有文字和一条 Pline 时，数量为顶点数 - 1，如果组内有文字和两条 pline 时，数量为第一个pline 线顶点数 -1）

(defun c:tt (/ pl txt blk)
(if
(and (setq pl
(car (xdrx_entsel "\n拾取回路Pline: " '((0 . "LWPOLYLINE")))
)
)
(setq txt (car (xdrx_entsel "\n拾取回路编号: " '((0 . "*TEXT")))))
(setq blk (car (xdrx_entsel "\n拾取图块: " '((0 . "INSERT")))))
)
(progn
(xdrx_group_make "*" pl txt)
(xdrx_xdata_setbyproperty
txt
"XDCircuit"
"String"
(car (xdrx_getpropertyvalue blk "BlockTableRecord"))
)
)
)
(princ)
)

st788796 · 发表于 2014-11-28 15:12:12

配合上面程序的统计

(defun c:tt (/ ss nl)
(if (setq ss (ssget '((0 . "text") (-3 ("XDCircuit")))))
(progn
(setq nl
(mapcar
'(lambda (x / lst ll n)
(if (setq lst (vl-remove-if
'(lambda (a)
(/= (xdrx_getpropertyvalue a "IsA")
"AcDbGroup"
)
)
(XD::Obj:Reactors x)
)
)
(progn
(setq
ll (xdrx_pickset->ents
(xdrx_getpropertyvalue
(car lst)
"allEntities"
)
)
n (xdrx_getpropertyvalue (car ll) "numVerts")
)
(list (xdrx_xdata_get x "XDCircuit")
(xdrx_getpropertyvalue (cadr ll) "textstring")
(if (= (length ll) 3)
n
(1- n)
)
)
)
)
)
(xdrx_pickset->ents ss)
)
)
(foreach x nl
(princ "\n")
(princ x)
)
)
)
(princ)
)

(defun c:tt (/ ss nl) 
  (if (setq ss (ssget '((0 . "text") (-3 ("XDCircuit"))))) 
    (progn 
      (setq nl 
             (mapcar 
               '(lambda        (x / lst ll n) 
                  (if (setq lst        (vl-remove-if 
                                  '(lambda (a) 
                                     (/= (xdrx_getpropertyvalue a "IsA") 
                                         "AcDbGroup" 
                                     ) 
                                   ) 
                                  (XD::Obj:Reactors x) 
                                ) 
                      ) 
                    (progn 
                      (setq 
                        ll (xdrx_pickset->ents 
                             (xdrx_getpropertyvalue 
                               (car lst) 
                               "allEntities" 
                             ) 
                           ) 
                        n  (xdrx_getpropertyvalue (car ll) "numVerts") 
                      ) 
                      (list (xdrx_xdata_get x "XDCircuit") 
                            (xdrx_getpropertyvalue (cadr ll) "textstring") 
                            (if        (= (length ll) 3) 
                              n 
                              (1- n) 
                            ) 
                      ) 
                    ) 
                  ) 
                ) 
               (xdrx_pickset->ents ss) 
             ) 
      ) 
      (foreach x nl 
        (princ "\n") 
        (princ x) 
      ) 
    ) 
  ) 
  (princ) 
)

grs432 · 发表于 2014-11-28 15:18:42

st788796 发表于 2014-11-28 15:12
配合上面程序的统计

现在正在准备测试，，真心的感谢st788796版主的支持，如果有机会，一定要当面感谢！！！{:soso_e100:}

我会努测试，将结果发到论坛上！！

newer · 发表于 2014-11-28 15:49:44

grs432 发表于 2014-11-28 15:18
现在正在准备测试，，真心的感谢st788796版主的支持，如果有机会，一定要当面感谢！！！
...

最起码做个漂亮的演示动画贴上来让大家看看。

grs432 · 发表于 2014-11-28 15:50:28

st788796 发表于 2014-11-28 14:22
增删顶点

现在测试增加和减少点上，在多段线中间加点和减点没有问题，不足之处是弧度与原来有不同，影响美观。
在头与尾部增加回路时会出问题，如上边动画所示。

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

[已解决] 块与块连线程序求助

点评

点评

点评

点评

点评

点评

点评

点评

点评