求高一点效率的均匀布置

viphappy · 发表于 2014-11-15 08:21:58

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

输入最大间距，选择需要布置的实体，待指定对齐基准点，指定开始布置的起点和终点。要求在布置的起点和终点之间均匀布置实体，下面代码效率很低，求效率高一点的。

(Defun C:Uniform-Layout ( / An Ang Devi Dis Msg P0 Pte Pts Sn Spac Ss)
(Setq Msg (Getdist "最大中距@≤<1500>:")
Devi (If Msg Msg 1500)
(Princ "\N选择要布置的对象: ")
(Setq Ss (Ssget)
P0 (Getpoint "\N指定对齐点: ")
)
(If (And Ss P0)
(While (And
(Setq Pts (Getpoint P0 "\N起始点: "))
(Setq Pte (Getpoint Pts "\N终止点: "))
)
(Setq Dis (Distance Pts Pte)
Ang (Angle Pts Pte)
Sn (Fix (+ (/ Dis Devi) 0.9999))
Spac (/ Dis Sn)
An (/ (* Ang 180) Pi)
)
(Vl-Cmdf "_.Rotate" Ss "" P0 An)
(Repeat Sn
(Setq Pte (Polar Pts Ang (* Spac Sn))
Sn (1- Sn))
(Vl-Cmdf "_.Copy" Ss "" P0 Pte "")
)
(Vl-Cmdf "_.Copy" Ss "" P0 Pts "")
(Vl-Cmdf "_.Rotate" Ss "" P0 (- 0 An))
)
)
(princ)
)

复制代码

st788796 · 发表于 2014-11-15 08:54:15

构造矩阵

(defun c:tt (/ ss p1 p2 spa an n mat p0)
(if (and (setq p0 (getpoint "\n基点: "))
(setq ss (ssget))
(setq spa (getdist p0 "\n间距: "))
)
(while (and (setq p1 (getpoint "\n第一点: "))
(setq p2 (getpoint p1 "\n第二点: "))
)
(setq an (angle p1 p2)
n (fix (+ (/ (distance p1 p2) spa) 0.5))
mat (xdrx_matrix_identity)
pts (xd::pnts:divide p1 p2 n)
)
(mapcar '(lambda (x)
(xdrx_entity_transformedcopy
ss
(xdrx_matrix_product
(xdrx_matrix_setrotation
mat
an
'(0.0 0.0 1.0)
x
) ;_旋转
(xdrx_matrix_settranslation mat (mapcar '- x p0)) ;_平移
)
)
)
pts
)
)
)
(princ)
)

(defun c:tt (/ ss p1 p2 spa an n mat p0) 
  (if (and (setq p0 (getpoint "\n基点: ")) 
           (setq ss (ssget)) 
           (setq spa (getdist p0 "\n间距: ")) 
      ) 
    (while (and        (setq p1 (getpoint "\n第一点: ")) 
                (setq p2 (getpoint p1 "\n第二点: ")) 
           ) 
      (setq an        (angle p1 p2) 
            n        (fix (+ (/ (distance p1 p2) spa) 0.5)) 
            mat        (xdrx_matrix_identity) 
            pts        (xd::pnts:divide p1 p2 n) 
      ) 
      (mapcar '(lambda (x) 
                 (xdrx_entity_transformedcopy 
                   ss 
                   (xdrx_matrix_product 
                     (xdrx_matrix_setrotation 
                       mat 
                       an 
                       '(0.0 0.0 1.0) 
                       x 
                     ) ;_旋转 
                     (xdrx_matrix_settranslation mat (mapcar '- x p0)) ;_平移 
                   ) 
                 ) 
               ) 
              pts 
      ) 
    ) 
  ) 
  (princ) 
)

liuyj · 发表于 2014-11-15 09:31:16

什么好东西还捂着？

/db_自贡黄明儒_ · 发表于 2014-11-15 11:45:48

据说用高飞的矩阵效率可以很高

newer · 发表于 2014-11-15 12:51:35

st788796 发表于 2014-11-15 08:54
构造矩阵

还可以简化代码哦，用 LISP函数库对齐矩阵XD::MATRIX:ALIGN 加上 getsamplePoints 等分点

st788796 · 发表于 2014-11-15 13:09:20

newer 发表于 2014-11-15 12:51
还可以简化代码哦，用 LISP函数库对齐矩阵XD::MATRIX:ALIGN 加上 getsamplePoints 等分点

那就简化一下

(defun c:tt (/ p0 ss spa ge p1 p2 an pts)
(if (and (setq p0 (getpoint "\n基点: "))
(setq ss (ssget))
(setq spa (getdist p0 "\n间距: "))
)
(progn
(setq ge (xdge::constructor "kLineSeg3d"))
(while (and (setq p1 (getpoint "\n第一点: "))
(setq p2 (getpoint p1 "\n第二点: "))
)
(xdge::setpropertyvalue ge "set" p1 p2)
(setq an (angle p1 p2)
pts (xdge::getpropertyvalue
ge
"getSamplePoints"
(fix (+ (/ (distance p1 p2) spa) 0.5))
)
)
(mapcar
'(lambda (x)
(xdrx_entity_transformedcopy
ss
(xd::matrix:align
p0
p0
x
(polar p0 0.0 1.0)
(polar x an 1.)
)
)
)
pts
)
)
)
)
(xdge::free)
(princ)
)

(defun c:tt (/ p0 ss spa ge p1 p2 an pts) 
  (if (and (setq p0 (getpoint "\n基点: ")) 
           (setq ss (ssget)) 
           (setq spa (getdist p0 "\n间距: ")) 
      ) 
    (progn 
      (setq ge (xdge::constructor "kLineSeg3d")) 
      (while (and (setq p1 (getpoint "\n第一点: ")) 
                  (setq p2 (getpoint p1 "\n第二点: ")) 
             ) 
        (xdge::setpropertyvalue ge "set" p1 p2) 
        (setq an  (angle p1 p2) 
              pts (xdge::getpropertyvalue 
                    ge 
                    "getSamplePoints" 
                    (fix (+ (/ (distance p1 p2) spa) 0.5)) 
                  ) 
        ) 
        (mapcar 
          '(lambda (x) 
             (xdrx_entity_transformedcopy 
               ss 
               (xd::matrix:align 
                 p0 
                 p0 
                 x 
                 (polar p0 0.0 1.0) 
                 (polar x an 1.) 
               ) 
             ) 
           ) 
          pts 
        ) 
      ) 
    ) 
  ) 
  (xdge::free) 
  (princ) 
)

newer · 发表于 2014-11-15 13:29:45

st788796 发表于 2014-11-15 13:09
那就简化一下

大师，应用要更广些的话，那个曲线不一定要直线哦，我又想起来几个函数，看看是否能更简洁
曲线等分点，每个点求一阶导数得到向量，和对齐第一点第二点向量求夹角，然后直接用 xdrx_entity_rotate一次，然后用 xdrx_entity_copy 到其他点过去，这样就能避免那些对矩阵不熟悉的人迷糊。都是ACAD基本ROTATE命令，COPY命令的ARX直接实现。

viphappy · 发表于 2014-11-15 13:30:43

本帖最后由 viphappy 于 2014-11-15 13:36 编辑

纯纯Lips效率真是很低，要布置的实体如果再大点就更慢了。多谢各位的大力支持，什么高飞的矩阵~~，什么对齐矩阵~~真心:dizzy:受教了

newer · 发表于 2014-11-15 13:33:46

viphappy 发表于 2014-11-15 13:30
多谢各位的大力支持，什么高飞的矩阵~~，什么对齐矩阵~~真心受教了

你不让讲效率嘛，矩阵是效率最高的了，任何曲线编辑的高级命令，最底层都是要变动矩阵进行几何变换的，现在直接让你用最底层的方法去操作，不明白要学习啊，这样才能提高自己嘛。

你等一会，ST会给你用我上面说的ROTATE,COPY的方法给你写一个，这个就贴近你的理解了。

newer · 发表于 2014-11-15 13:39:29

viphappy 发表于 2014-11-15 13:30
纯纯Lips效率真是很低，要布置的实体如果再大点就更慢了。多谢各位的大力支持，什么高飞的矩阵~~，什么对齐 ...

对了，问你下，你那个基本实体只选了一次基点，那个旋转角度你怎么默认定的？基本实体是块吗？一个基点定不了旋转多少角度啊。

viphappy · 发表于 2014-11-15 13:52:40

newer 发表于 2014-11-15 13:39
对了，问你下，你那个基本实体只选了一次基点，那个旋转角度你怎么默认定的？基本实体是块吗？一个基点 ...

基本实体不是块，就是在后面做了2次旋转，先转到直线所成的角，COPY后又转回原来的角，笨笨的办法{:soso_e120:}

newer · 发表于 2014-11-15 14:03:06

viphappy 发表于 2014-11-15 13:52
基本实体不是块，就是在后面做了2次旋转，先转到直线所成的角，COPY后又转回原来的角，笨笨的办法{:soso_ ...

你默认的基本实体的角度是0度啊？

你的代码效率慢，就是多做了好几次旋转和拷贝，你在循环体外旋转一次，在循环体内直接就COPY，另外你想用多次，先直接复制一个实体，用副本去操作。省得再转回来了。

矩阵之所以快，因为这些旋转，COPY，不管中间你进行多少种变换，这些变换都最终可以用一个组合矩阵来表达，矩阵作用一次，就达到你的所有目的了。

st788796 · 发表于 2014-11-15 14:20:42

newer 发表于 2014-11-15 13:33
你不让讲效率嘛，矩阵是效率最高的了，任何曲线编辑的高级命令，最底层都是要变动矩阵进行几何变换的，现 ...

用 Rotate 和 Copy 就这样
API 版

(defun c:tt (/ ss p1 p2 spa an n p0)
(if (and (setq p0 (getpoint "\n基点: "))
(setq ss (ssget))
(setq spa (getdist p0 "\n间距: "))
)
(progn
(while (and (setq p1 (getpoint "\n第一点: "))
(setq p2 (getpoint p1 "\n第二点: "))
)
(if an
(xdrx_entity_rotate ss (- an) p0) ;_先转正
)
(setq an (angle p1 p2)
n (fix (+ (/ (distance p1 p2) spa) 0.5))
pts (xd::pnts:divide p1 p2 n)
)
(xdrx_entity_rotate ss an p0) ;_旋转到和线一个角度
(mapcar '(lambda (x)
(xdrx_entity_copy ss p0 x) ;_复制
)
pts
)
)
(if an
(xdrx_entity_rotate ss (- an) p0) ;_先转正
)
)
)
(princ)
)

Autolisp command

(defun c:tt (/ ss p1 p2 spa an n p0)
(defun r2d (a) (* 180. (/ a pi)))
(if (and (setq p0 (getpoint "\n基点: "))
(setq ss (ssget))
(setq spa (getdist p0 "\n间距: "))
)
(progn
(setvar "cmdecho" 0)
(while (and (setq p1 (getpoint "\n第一点: "))
(setq p2 (getpoint p1 "\n第二点: "))
)
(if an
(vl-cmdf ".rotate" ss "" p0 (- (r2d an))) ;_先转正
)
(setq an (angle p1 p2)
n (fix (+ (/ (distance p1 p2) spa) 0.5))
pts (xd::pnts:divide p1 p2 n)
)
(vl-cmdf ".rotate" ss "" p0 (r2d an)) ;_旋转到和线一个角度
(vl-cmdf ".copy" ss "" "o" "m" "_none" p0)
(foreach x pts (command "_none" x))
(command "")
)
(if an
(vl-cmdf ".rotate" ss "" p0 (- (r2d an))) ;_先转正
)
)
)
(princ)
)

(defun c:tt (/ ss p1 p2 spa an n p0) 
  (defun r2d (a) (* 180. (/ a pi))) 
  (if (and (setq p0 (getpoint "\n基点: ")) 
           (setq ss (ssget)) 
           (setq spa (getdist p0 "\n间距: ")) 
      ) 
    (progn 
      (setvar "cmdecho" 0) 
      (while (and (setq p1 (getpoint "\n第一点: ")) 
                  (setq p2 (getpoint p1 "\n第二点: ")) 
             ) 
        (if an 
          (vl-cmdf ".rotate" ss "" p0 (- (r2d an))) ;_先转正 
        ) 
        (setq an  (angle p1 p2) 
              n          (fix (+ (/ (distance p1 p2) spa) 0.5)) 
              pts (xd::pnts:divide p1 p2 n) 
        ) 
        (vl-cmdf ".rotate" ss "" p0 (r2d an)) ;_旋转到和线一个角度 
        (vl-cmdf ".copy" ss "" "o" "m" "_none" p0) 
        (foreach x pts (command "_none"  x)) 
        (command "") 
      ) 
      (if an 
        (vl-cmdf ".rotate" ss "" p0 (- (r2d an))) ;_先转正 
      ) 
    ) 
  ) 
  (princ) 
)

bai2000 · 发表于 2014-11-18 14:05:53

好像还没一个程序能用:L:L:L:L:L:L

st788796 · 发表于 2014-11-18 17:14:55

bai2000 发表于 2014-11-18 14:05
好像还没一个程序能用

楼上的都能用

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

[求助] 求高一点效率的均匀布置

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评

点评

点评