[原创]：另一种等分

kfboyxwa · 发表于 2003-1-13 14:27:18

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

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

×

我用不了

ydf7332462 · 发表于 2003-1-16 21:48:23

Divide 就行!

梦断江南 · 发表于 2003-1-17 00:16:12

最初由 kfboyxwa 发布
[B]我用不了 [/B]

程序里面用了xdapi函数，你要先加载晓东工具箱。

XDSoft · 发表于 2003-1-17 00:30:10

最初由 aeo 发布
[B]前几天画图,遇到的问题:
一段墙8000用300的柱子等分为5份(5个窗,4个柱,也可以5个窗6个柱).
由于不知道五等分好看还是六等分好看,算呀算,花了不少时间,晚上决定写一下.
这下不用犯愁了.
大家用得着的话,试试.
[c... [/B]

在曲线上，好像阵列后，不平行了（是否就要这效果？）

推荐你使用矩阵的方法，用 xdrx_entity_transFormedCopy 代码要精简好多（篇幅至少应该缩短一半），有空你试试。

aeo · 发表于 2003-1-20 23:02:26

最初由 XDSoft 发布
在曲线上，好像阵列后，不平行了（是否就要这效果？）
推荐你使用矩阵的方法，用 xdrx_entity_transFormedCopy 代码要精简好多... 有空你试试。

1就要这样,法线方向的.
2没原物体,xdrx_entity_transFormedCopy 就没必要了,做个标记而已,我只要画一定长度的线.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
xdrx_entity_transFormedCopy 到是用过,可惜贴了个把月了,你也不答,
不引用了,再贴一次.
顺便把我认为的错也改了(xdrx_curve_getarea)

程序是把物体随一曲线等分或等距array,用工具箱的xarray总觉的不是那么回事,所以重写了.(那么画太累)
小用了一下api里的矩阵转换,弄清楚花了不少时间,蛮好用的.

;欢迎大家试用和改进! by aeo
(defun c:xa (/ $get_point1 getpd _dist array-it _len box curve how num p0 ss
ss1 yes-mi yes-ro
)
(defun $get_point1 (e n dist / j pt ptl)
(setq j 1)
(while (< j n)
(setq pt (xdrx_curve_getpointatdist e (* j dist)))
(if pt
(setq ptl (cons pt ptl))
)
(setq j (1+ j))
)
(reverse ptl)
)
; ************************
(defun getpd (/ no s-pd)
(if (not #xarray_dist)
(setq #xarray_dist 100)
)
(setq s-pd (getstring (strcat "\n等分数$加X$或距离("
(rtos #xarray_dist 2 2) "):"
)
)
)
(cond
((setq no (xdrx_txtsrch s-pd "x"))
(setq s-pd (substr s-pd 1 (1- (car no))))
(setq s-pd (atoi s-pd))
(setq s-pd (cons 0 s-pd))
)
(t
(if (= s-pd "")
(setq s-pd #xarray_dist)
(setq s-pd (atof s-pd))
)
(setq s-pd (cons 1 s-pd))
)
)
)
; ***************************to array
(defun array-it (p0 ss yes-ro yes-mi num _dist how / angl p1 p2 pntl pntl1
xform xform1 xform2 ss1
)
(setq p1 (car (xdrx_curve_GetPoint curve)))
(setq p2 (caddr (xdrx_curve_GetPoint curve)))
(setq pntl ($get_point1 curve num _dist) ; mid point
pntl (cons p1 pntl) ; first point
)
(if (= how 0)
(setq pntl (reverse (cons p2 (reverse pntl)))) ; last point
)
(if (= yes-ro "Yes")
(setq angl (mapcar
'(lambda (x)
(cadr (xdrx_getperpline curve x))
)
pntl
)
)
)
(if yes-mi
(setq angl nil
angl (mapcar
'(lambda (x)
(- (cadr (xdrx_getperpline curve x)) pi)
)
pntl
)
)
)
(setq pntl1 (mapcar
'(lambda (x)
(mapcar
'-
x
p0
)
)
pntl
)
)
(setq xForm (xdrx_matrix_identity 3)
xForm1 (mapcar
'(lambda (x)
(xdrx_matrix_setTransLation xForm x)
)
pntl1
)
)
(if (= yes-ro "Yes")
(progn
(setq xform2 (mapcar
'(lambda (x y)
(xdrx_matrix_setRotation xform x '(0 0 1) y)
)
angl
pntl
)
)
(setq xform1 (mapcar
'(lambda (x y)
(xdrx_matrix_product x y)
)
xform2
xform1
)
)
)
)
(c:xdrx_setmark)
(mapcar
'(lambda (x)
(xdrx_entity_transformedcopy ss x)
)
xForm1
)
(setq ss1 (c:xdrx_getss))
)
; ***************************************main
(prompt "\n请选取要阵列的实体<退出>")
(setq ss (ssget))
(if ss
(progn
(setq p0 (getpoint "\n基点:$回车取中点$:"))
(if (not p0)
(setq box (xdrx_entity_box ss)
p0 (xdrx_midp (car box) (caddr box))
)
)
(setq curve (car (xdrx_entsel "\n点取一个路径<esc>:" '((0 . "*line,arc,circle,ellipse")))))
)
)
(if (and
ss
curve
)
(progn
(xdrx_begin)
(xdrx_ucson)
(princ (strcat "\n当前路径长:"
(rtos (setq _len (xdrx_curve_getDistAtPoint curve(last (xdrx_curve_GetPoint curve))) )2 2)))
(setq _dist (getpd))
(setq how (car _dist)
_dist (cdr _dist)
)
(if (= how 0)
(setq num _dist
_dist (/ _len _dist)
)
(setq num (fix (1+(/ _len _dist))))
)
(setq #xarray_dist _dist)
(initget "Yes No")
(setq yes-ro (getkword "\n要随着转吗<(Yes)or No>?"))
(if (not yes-ro)
(setq yes-ro "Yes")
)
(setq ss1 (array-it p0 ss yes-ro nil num _dist how))
[COLOR=red]; (xdrx_PickSet_redraw ss1) [/COLOR]
(if (= yes-ro "Yes")
(progn
(initget "Yes No")
(setq yes-mi (getkword "\n要内外镜向吗<Yes or (No)>?"))
(if (not yes-mi)
(setq yes-mi "No")
)
(if (= "Yes" yes-mi)
(progn
(command "erase" ss1 "")
(array-it p0 ss yes-ro t num _dist how)
)
[COLOR=red]; (xdrx_PickSet_redraw ss1 t)[/COLOR]
)
)
)
(xdrx_ucsoff)
(xdrx_end)
)
)
(princ)
)

;欢迎大家试用和改进! by aeo 
(defun c:xa (/ $get_point1 getpd _dist array-it _len box curve how num p0 ss 
               ss1 yes-mi yes-ro 
            ) 
  (defun $get_point1 (e n dist / j pt ptl) 
    (setq j 1) 
    (while (< j n) 
      (setq pt (xdrx_curve_getpointatdist e (* j dist))) 
      (if pt 
        (setq ptl (cons pt ptl)) 
      ) 
      (setq j (1+ j)) 
    ) 
    (reverse ptl) 
  )                                        
; ************************ 
  (defun getpd (/ no s-pd) 
    (if (not #xarray_dist) 
      (setq #xarray_dist 100) 
    ) 
    (setq s-pd (getstring (strcat "\n等分数$加X$或距离(" 
                                  (rtos #xarray_dist 2 2) "):" 
                          ) 
               ) 
    ) 
    (cond 
      ((setq no (xdrx_txtsrch s-pd "x")) 
        (setq s-pd (substr s-pd 1 (1- (car no)))) 
        (setq s-pd (atoi s-pd)) 
        (setq s-pd (cons 0 s-pd)) 
      ) 
      (t 
        (if (= s-pd "") 
          (setq s-pd #xarray_dist) 
          (setq s-pd (atof s-pd)) 
        ) 
        (setq s-pd (cons 1 s-pd)) 
      ) 
    ) 
  )                                        
; ***************************to array 
  (defun array-it (p0 ss yes-ro yes-mi num _dist how / angl p1 p2 pntl pntl1 
                      xform xform1 xform2 ss1 
                  ) 
    (setq p1 (car (xdrx_curve_GetPoint curve))) 
    (setq p2 (caddr (xdrx_curve_GetPoint curve))) 
    (setq pntl ($get_point1 curve num _dist)         ; mid point 
          pntl (cons p1 pntl)                        ; first point 
    )                                        
    (if (= how 0) 
      (setq pntl (reverse (cons p2 (reverse pntl)))) ; last point 
    )                                      
    (if (= yes-ro "Yes") 
      (setq angl (mapcar 
                   '(lambda (x) 
                      (cadr (xdrx_getperpline curve x)) 
                    ) 
                   pntl 
                 ) 
      ) 
    ) 
    (if yes-mi 
      (setq angl nil 
            angl (mapcar 
                   '(lambda (x) 
                      (- (cadr (xdrx_getperpline curve x)) pi) 
                    ) 
                   pntl 
                 ) 
      ) 
    ) 
    (setq pntl1 (mapcar 
                  '(lambda (x) 
                     (mapcar 
                       '- 
                       x 
                       p0 
                     ) 
                   ) 
                  pntl 
                ) 
    ) 
    (setq xForm (xdrx_matrix_identity 3) 
          xForm1 (mapcar 
                   '(lambda (x) 
                      (xdrx_matrix_setTransLation xForm x) 
                    ) 
                   pntl1 
                 ) 
    ) 
    (if (= yes-ro "Yes") 
      (progn 
        (setq xform2 (mapcar 
                       '(lambda (x y) 
                          (xdrx_matrix_setRotation xform x '(0 0 1) y) 
                        ) 
                       angl 
                       pntl 
                     ) 
        ) 
        (setq xform1 (mapcar 
                       '(lambda (x y) 
                          (xdrx_matrix_product x y) 
                        ) 
                       xform2 
                       xform1 
                     ) 
        ) 
      ) 
    ) 
    (c:xdrx_setmark) 
    (mapcar 
      '(lambda (x) 
         (xdrx_entity_transformedcopy ss x) 
       ) 
      xForm1 
    ) 
    (setq ss1 (c:xdrx_getss)) 
  )                                        
; ***************************************main 
  (prompt "\n请选取要阵列的实体<退出>") 
  (setq ss (ssget)) 
  (if ss 
    (progn 
      (setq p0 (getpoint "\n基点:$回车取中点$:")) 
      (if (not p0) 
        (setq box (xdrx_entity_box ss) 
              p0 (xdrx_midp (car box) (caddr box)) 
        ) 
      ) 
      (setq curve (car (xdrx_entsel "\n点取一个路径<esc>:" '((0 . "*line,arc,circle,ellipse"))))) 
    ) 
  ) 
  (if (and 
        ss 
        curve 
      ) 
    (progn 
      (xdrx_begin) 
      (xdrx_ucson) 
      (princ (strcat "\n当前路径长:" 
             (rtos (setq _len (xdrx_curve_getDistAtPoint curve(last (xdrx_curve_GetPoint curve))) )2 2))) 
      (setq _dist (getpd)) 
      (setq how (car _dist) 
            _dist (cdr _dist) 
      ) 
      (if (= how 0) 
        (setq num _dist 
              _dist (/ _len _dist) 
        ) 
        (setq num (fix (1+(/ _len _dist)))) 
      ) 
      (setq #xarray_dist _dist) 
      (initget "Yes No") 
      (setq yes-ro (getkword "\n要随着转吗<(Yes)or No>?")) 
      (if (not yes-ro) 
        (setq yes-ro "Yes") 
      ) 
      (setq ss1 (array-it p0 ss yes-ro nil num _dist how)) 
      [COLOR=red];  (xdrx_PickSet_redraw ss1)   [/COLOR] 
      (if (= yes-ro "Yes") 
        (progn 
          (initget "Yes No") 
          (setq yes-mi (getkword "\n要内外镜向吗<Yes or (No)>?")) 
          (if (not yes-mi) 
            (setq yes-mi "No") 
          ) 
          (if (= "Yes" yes-mi) 
            (progn 
              (command "erase" ss1 "") 
              (array-it p0 ss yes-ro t num _dist how) 
            )                                
       [COLOR=red]; (xdrx_PickSet_redraw ss1 t)[/COLOR] 
          ) 
        ) 
      ) 
      (xdrx_ucsoff) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

晓东把xdrx_PickSet_redraw 注释去掉试试,我这不行.我要问的就是这!

忘写用法了,有人问过的:
选物体,选路径,回答几份
12等分键入12x 如键12就是距离为12.

hewb · 发表于 2003-2-8 16:41:53

精彩！感谢！

ydf7332462 · 发表于 2003-2-10 22:33:44

1 从图上看:等距或等分仍然是两角尖之间的curve长度相等
  autocad的Divide Measure完全可以很简单地作到. 以前
  贴过论坛上作到控制起终点
2 "另一种等分" 我发贴请求过(有贴要求同我）:是将上边的
curve长度改为distance（两角尖之间的直线）,其余同上.
可Divide Measure 可控制起终点

1 我发贴请求的"另一种等分" 无从得到
2 请楼主考虑：曲线是一个GROUP 起点可选 default为曲线的起点
                                 终点可选 default为曲线的终端点

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

[原创]：另一种等分

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

相关帖子

Re: [原创]：另一种等分

Re: Re: [原创]：另一种等分