块与块连线程序求助

grs432 · 发表于 2014-11-19 16:15:48

st788796 发表于 2014-11-19 15:49
你先把 XDAPI 和 xd-lisp-lib.vlx 加载

xdrx_polyline_numverts 这个是返回多段线顶点数的，，怎么在命令中体现不出来呢？？

st788796 · 发表于 2014-11-19 16:25:20

grs432 发表于 2014-11-19 16:15
xdrx_polyline_numverts 这个是返回多段线顶点数的，，怎么在命令中体现不出来呢？？

先给你个画线并作组的

(defun c:tt (/ p pts p d pl pl1 p1 str tf)
(while (setq p (if pts
(getpoint (car pts) "\n下一点: ")
(getpoint "\n起点: ")
)
)
(setq pts (cons p pts))
(if (= (length pts) 2)
(progn
(setq p (getpoint (apply 'xdrx_line_midp pts) "\n弦高: ")
d (* 2 (xdrx_point_dist2line p (cadr pts) (car pts)))
)
(setq pl (xdrx_polyline_make (cadr pts) (car pts)))
(xdrx_polyline_setbulgeat pl 0 (/ d (apply 'distance pts)))
)
)
(if (and pl (> (length pts) 2))
(progn
(setq n (xdrx_polyline_numverts pl))
(xdrx_polyline_setpointat pl (1- n) (car pts))
(xdrx_polyline_addvertexat pl (1- n) (cadr pts))
(xdrx_polyline_setbulgeat
pl
(- n 2)
(/ d (distance (cadr pts) (caddr pts)))
)
(xdrx_polyline_setbulgeat
pl
(1- n)
(/ d (distance (car pts) (cadr pts)))
)
)
)
)
(if (and pl
(if (setq p (getpoint "\n引出点<回车端点>: "))
(progn
(setq tf nil)
p
)
(setq tf t
p (xdrx_curve_getendpoint pl)
)
)
(setq p1 (getpoint p "\n标注点: "))
(setq str (getstring "\n回路编号: "))
)
(progn
(setq
txt (xdrx_text_make p1 (strcase str) (getvar "textsize") 0.0)
pl1 (xdrx_polyline_make p p1)
)
(xdrx_polyline_setbulgeat pl1 0 0.5)
(if tf
(progn
(xdrx_curve_join pl pl1)
(xdrx_group_make "*" pl txt)
)
(xdrx_group_make "*" pl txt pl1)
)
)
)
(princ)
)

(defun c:tt (/ p pts p d pl pl1 p1 str tf) 
  (while (setq p (if pts 
                   (getpoint (car pts) "\n下一点: ") 
                   (getpoint "\n起点: ") 
                 ) 
         ) 
    (setq pts (cons p pts)) 
    (if        (= (length pts) 2) 
      (progn 
        (setq p        (getpoint (apply 'xdrx_line_midp pts) "\n弦高: ") 
              d        (* 2 (xdrx_point_dist2line p (cadr pts) (car pts))) 
        ) 
        (setq pl (xdrx_polyline_make (cadr pts) (car pts))) 
        (xdrx_polyline_setbulgeat pl 0 (/ d (apply 'distance pts))) 
      ) 
    ) 
    (if        (and pl (> (length pts) 2)) 
      (progn 
        (setq n (xdrx_polyline_numverts pl)) 
        (xdrx_polyline_setpointat pl (1- n) (car pts)) 
        (xdrx_polyline_addvertexat pl (1- n) (cadr pts)) 
        (xdrx_polyline_setbulgeat 
          pl 
          (- n 2) 
          (/ d (distance (cadr pts) (caddr pts))) 
        ) 
        (xdrx_polyline_setbulgeat 
          pl 
          (1- n) 
          (/ d (distance (car pts) (cadr pts))) 
        ) 
      ) 
    ) 
  ) 
  (if (and pl 
           (if (setq p (getpoint "\n引出点<回车端点>: ")) 
             (progn 
               (setq tf nil) 
               p 
             ) 
             (setq tf t 
                   p  (xdrx_curve_getendpoint pl) 
             ) 
           ) 
           (setq p1 (getpoint p "\n标注点: ")) 
           (setq str (getstring "\n回路编号: ")) 
      ) 
    (progn 
      (setq 
        txt (xdrx_text_make p1 (strcase str) (getvar "textsize") 0.0) 
        pl1 (xdrx_polyline_make p p1) 
      ) 
      (xdrx_polyline_setbulgeat pl1 0 0.5) 
      (if tf 
        (progn 
          (xdrx_curve_join pl pl1) 
          (xdrx_group_make "*" pl txt) 
        ) 
        (xdrx_group_make "*" pl txt pl1) 
      ) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-11-19 17:14:28

如果文字和线做成组就可以这样统计

(defun c:tt (/ ss nl)
(if (setq ss (ssget '((0 . "text"))))
(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_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")))) 
    (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_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-19 17:35:49

st788796 发表于 2014-11-19 17:14
如果文字和线做成组就可以这样统计

好的，非常感谢，我现在就试一下，对于论坛的函数库还不是特别了解，，先一个个对照着读。还是要努力学习~！！

grs432 · 发表于 2014-11-19 17:56:16

本帖最后由 grs432 于 2014-11-19 18:01 编辑

st788796 发表于 2014-11-19 17:14
如果文字和线做成组就可以这样统计

成组后为什么统计错误？？

iLisp · 发表于 2014-11-19 18:20:51

grs432 发表于 2014-11-19 17:56
成组后为什么统计错误？？

在开源函数库

grs432 · 发表于 2014-11-19 18:28:29

iLisp 发表于 2014-11-19 18:20
在开源函数库

xd-lisp-lib.VLX我加载了呀！！！

newer · 发表于 2014-11-19 18:44:33

grs432 发表于 2014-11-19 17:56
成组后为什么统计错误？？

那不提示你缺函数了吗，去看看今天最新帖子，今天更新的一个函数。

grs432 · 发表于 2014-11-19 18:45:13

grs432 发表于 2014-11-19 17:56
成组后为什么统计错误？？

选择对象: 指定对角点: 找到 4 个，4 个编组
选择对象: ; 错误: no function definition: XD::OBJ:REACTORS

这是什么问题呢？？

newer · 发表于 2014-11-19 18:47:35

grs432 发表于 2014-11-19 18:45
选择对象: 指定对角点: 找到 4 个，4 个编组
选择对象: ; 错误: no function definition: XD::OBJ:REAC ...

去看看今天最新的帖子，提供的函数。

eachy · 发表于 2014-11-19 19:20:19

grs432 发表于 2014-11-19 18:45
选择对象: 指定对角点: 找到 4 个，4 个编组
选择对象: ; 错误: no function definition: XD::OBJ:REAC ...

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

grs432 · 发表于 2014-11-19 21:20:01

eachy 发表于 2014-11-19 19:20
http://bbs.xdcad.net/thread-677350-1-1.html

对呀！！终于思路对上了呀！！后边只能靠自己整理了呀！！谢谢了呀！！！

iLisp · 发表于 2014-11-19 21:48:03

grs432 发表于 2014-11-19 21:20
对呀！！终于思路对上了呀！！后边只能靠自己整理了呀！！谢谢了呀！！！

剩下做Table或写出xls很简单了

grs432 · 发表于 2014-11-21 11:43:45

本帖最后由 grs432 于 2014-11-21 12:06 编辑

st788796 发表于 2014-11-19 16:25
先给你个画线并作组的

st788796您好，首先非常感谢您对我的问题的耐心解答，我也是认真的在试用您给的工具，为了让工具更完美些，我有几个建议。1、请问画线的时候点击下一点时如果点错了，能支持回退吗？CAD中回退是U的命令。这样子如果错了，退回重新再点。

2、另外还有个问题，如果成组后，再想加入线的话，能不能再给出个命令是先解组再画线的并且画上的线可以与以前的多段线直接连接在一起。画完线后重新打组。

3、另外，可以将点击自动连接以前的多段线单独写1个程序，这样会很方便。

st788796 · 发表于 2014-11-21 11:51:29

本帖最后由 st788796 于 2014-11-21 11:52 编辑

grs432 发表于 2014-11-21 11:43
st788796您好，首先非常感谢您对我的问题的耐心解答，我也是认真的在试用您给的工具，为了让工具更完美些 ...

首先，没有这样画过，只是凭自己想象出的操作模式写的程序，和实际应用肯定有距离

再者，你把实际中所能用到的操作都写写，这样再总结分成几个功能或者一个程序中的几个选项

1 2 3 问题都好解决

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

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

点评

点评

点评

点评

点评

点评

点评

点评