直线、多段线转粗糙线

Lispboy · 发表于 2018-9-29 00:14:18

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

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

×

(defun c:XDTB_ROUGHEN (/ ss val i e dist1 dist2 dists #length #startpoint #endpoint pts fv)
(if (and (xdrx_initssget "\n选择直线、多段线<退出>:")
(setq ss (xdrx_ssget '((0 . "*polyline,line"))))
)
(progn
(if (not #xd_var_global_dist1)
(setq #xd_var_global_dist1 1.0)
)
(if (setq val (getreal (xdrx_prompt
"\n长度方向范围精度<"
#xd_var_global_dist1
">:"
t
)
)
)
(setq #xd_var_global_dist1 val)
)
(if (not #xd_var_global_dist2)
(setq #xd_var_global_dist2 1.0)
)
(if (setq val (getreal (xdrx_prompt
"\n左右方向范围精度<"
#xd_var_global_dist2
">:"
t
)
)
)
(setq #xd_var_global_dist2 val)
)
(mapcar
'(lambda (e)
(xdrx_getpropertyvalue e "length" "startpoint" "endpoint")
(setq dists nil)
(while (> #length 0)
(setq dist1 (xdrx_math_rand
(/ #xd_var_global_dist1 10.0)
#xd_var_global_dist1
)
)
(setq dists (cons dist1 dists)
#length (- #length dist1)
)
)
(setq pts (xdrx_curve_getpointsatdists e dists)
)
(setq i 0)
(setq pts (mapcar
'(lambda (x)
(setq fv (xdrx_vector_normalize
(xdrx_curve_getfirstderiv e x)
)
)
(if (= (rem i 2) 0)
(setq fv (xdrx_vector_perpvector fv))
(setq fv (xdrx_vector_negate
(xdrx_vector_perpvector fv)
)
)
)
(setq i (1+ i))
(mapcar '+
x
(xdrx_vector_product
fv
(xdrx_math_rand 0 #xd_var_global_dist2)
)
)
)
pts
)
pts (cons #startpoint pts)
pts (append pts (list #endpoint))
)
(xdrx_polyline_make pts)
)
(xdrx_pickset->ents ss)
)
)
)
(princ)
)

(defun c:XDTB_ROUGHEN (/ ss val i e dist1 dist2 dists #length #startpoint #endpoint pts fv) 
  (if (and (xdrx_initssget "\n选择直线、多段线<退出>:") 
           (setq ss (xdrx_ssget '((0 . "*polyline,line")))) 
      ) 
    (progn 
      (if (not #xd_var_global_dist1) 
        (setq #xd_var_global_dist1 1.0) 
      ) 
      (if (setq        val (getreal (xdrx_prompt 
                               "\n长度方向范围精度<" 
                               #xd_var_global_dist1 
                               ">:" 
                               t 
                             ) 
                    ) 
          ) 
        (setq #xd_var_global_dist1 val) 
      ) 
      (if (not #xd_var_global_dist2) 
        (setq #xd_var_global_dist2 1.0) 
      ) 
      (if (setq        val (getreal (xdrx_prompt 
                               "\n左右方向范围精度<" 
                               #xd_var_global_dist2 
                               ">:" 
                               t 
                             ) 
                    ) 
          ) 
        (setq #xd_var_global_dist2 val) 
      ) 
      (mapcar 
        '(lambda (e) 
           (xdrx_getpropertyvalue e "length" "startpoint" "endpoint") 
           (setq dists nil) 
           (while (> #length 0) 
             (setq dist1 (xdrx_math_rand 
                           (/ #xd_var_global_dist1 10.0) 
                           #xd_var_global_dist1 
                         ) 
             ) 
             (setq dists   (cons dist1 dists) 
                   #length (- #length dist1) 
             ) 
           ) 
           (setq pts (xdrx_curve_getpointsatdists e dists) 
           ) 
           (setq i 0) 
           (setq pts (mapcar 
                       '(lambda        (x) 
                          (setq        fv (xdrx_vector_normalize 
                                     (xdrx_curve_getfirstderiv e x) 
                                   ) 
                          ) 
                          (if (= (rem i 2) 0) 
                            (setq fv (xdrx_vector_perpvector fv)) 
                            (setq fv (xdrx_vector_negate 
                                       (xdrx_vector_perpvector fv) 
                                     ) 
                            ) 
                          ) 
                          (setq i (1+ i)) 
                          (mapcar '+ 
                                  x 
                                  (xdrx_vector_product 
                                    fv 
                                    (xdrx_math_rand 0 #xd_var_global_dist2) 
                                  ) 
                          ) 
                        ) 
                       pts 
                     ) 
                 pts (cons #startpoint pts) 
                 pts (append pts (list #endpoint)) 
           ) 
           (xdrx_polyline_make pts) 
         ) 
        (xdrx_pickset->ents ss) 
      ) 
    ) 
  ) 
  (princ) 
)

evayleung · 发表于 2018-9-29 01:30:20

这功能好用，对加固工程来说经常要用到。

lixiaolin · 发表于 2018-9-30 14:51:01

谢谢楼主，

xudongchu · 发表于 2018-9-30 15:21:11

谢谢您的分享~

=^_^= · 发表于 2018-9-30 16:08:58

不错的功能

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

[多段线] 直线、多段线转粗糙线

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