在三角网内均匀布置点

st788796 · 发表于 2016-2-23 14:38:54

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

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

×

本帖最后由 st788796 于 2016-2-23 14:51 编辑

计算点标高后续再加

(defun c:tt (/ p1 p2 ss d w h p0 tmp pts lst)
(if (and (setq p1 (getpoint "\nFirst Corner: "))
(setq p2 (getcorner p1 "\nOrther Corner: "))
(setq ss (ssget "C" p1 p2 '((0 . "polyline"))))
(setq d (getdist p1 "\nSpace Distance: "))
)
(progn
(mapcar 'set '(w h) (mapcar 'abs (mapcar '- p2 p1)))
(repeat (1+ (fix (/ h d)))
(setq p0 p1)
(repeat (1+ (fix (/ w d)))
(setq tmp (cons p0 tmp)
p0 (polar p0 0 d)
)
)
(setq pts (cons tmp pts)
p1 (polar p1 (/ pi 2) d)
tmp nil
)
)
(setq ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
lst (mapcar '(lambda (x)
(list x
(mapcar '(lambda (a)
(list (car a) (cadr a))
)
(xdrx_entity_getstretchpoint x)
)
)
)
(xdrx_pickset->ents ss)
)
)
(foreach x pts
(foreach a x
(if
(vl-some '(lambda (b)
(apply 'xdrx_point_isinside
(cons (list (car a) (cadr a)) (cadr b))
)
)
lst
)
(vla-addpoint ms (vlax-3d-point a))
)
)
)
)
)
(princ)
)

(defun c:tt (/ p1 p2 ss d w h p0 tmp pts lst) 
  (if (and (setq p1 (getpoint "\nFirst Corner: ")) 
           (setq p2 (getcorner p1 "\nOrther Corner: ")) 
           (setq ss (ssget "C" p1 p2 '((0 . "polyline")))) 
           (setq d (getdist p1 "\nSpace Distance: ")) 
      ) 
    (progn 
      (mapcar 'set '(w h) (mapcar 'abs (mapcar '- p2 p1))) 
      (repeat (1+ (fix (/ h d))) 
        (setq p0 p1) 
        (repeat        (1+ (fix (/ w d))) 
          (setq        tmp (cons p0 tmp) 
                p0  (polar p0 0 d) 
          ) 
        ) 
        (setq pts (cons tmp pts) 
              p1  (polar p1 (/ pi 2) d) 
              tmp nil 
        ) 
      ) 
      (setq ms        (vla-get-modelspace 
                  (vla-get-activedocument (vlax-get-acad-object)) 
                ) 
            lst        (mapcar        '(lambda (x) 
                           (list x 
                                 (mapcar '(lambda (a) 
                                            (list (car a) (cadr a)) 
                                          ) 
                                         (xdrx_entity_getstretchpoint x) 
                                 ) 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
      ) 
      (foreach x pts 
        (foreach a x 
          (if 
            (vl-some '(lambda (b) 
                        (apply 'xdrx_point_isinside 
                               (cons (list (car a) (cadr a)) (cadr b)) 
                        ) 
                      ) 
                     lst 
            ) 
             (vla-addpoint ms (vlax-3d-point a)) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

dnbcgrass · 发表于 2016-2-23 15:52:35

学习学习！

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

[教学] 在三角网内均匀布置点

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