(XD::Pnts:Visible)判断点表（多段线实体表）哪些点对一条直线可见

newer · 发表于 2016-5-30 20:20:14

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

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

×

本帖最后由 newer 于 2016-6-13 08:57 编辑

(defun XD::Pnts:Visible (pts p1 p2 / e ints ints1 pt1 pt2 pts1 pts2 ptss x y)
(defun _isInt (ptss pt1 pt2)
(vl-some '(lambda (x)
(xdrx_curve_getinters (list pt1 pt2) x)
) ptss
)
)
(setq pts (xd::list:removedup pts))
(setq pts1 (mapcar
'(lambda (x)
(cond
((= (type x) 'ENAME)
(xdrx_getpropertyvalue x "vertices")
)
((= (type x) 'LIST)
x
)
)
)
pts
)
)
(setq pts2 (vl-remove nil (mapcar
'(lambda (x / e)
(setq e (xdrx_polyline_make x t))
(setq ints1 nil)
(mapcar
'(lambda (y)
(if (setq pts2
(xd::pnts:orthoproject
(list y)
p1 p2
)
)
(progn
(if (setq ints
(xdrx_curve_getinters
(list
(car pts2) y
)
e
)
)
(progn
(if (and
(= (length ints) 1)
(not (_isInt
(vl-remove x pts1)
(car pts2)
(car ints)
)
)
)
(setq ints1 (cons
(car ints)
ints1
)
)
)
)
)
)
)
)
x
)
(xdrx_entity_delete e)
(vl-remove nil (mapcar
'cadr
(xdrx_points_sortoncurve
(list p1 p2) ints1
)
)
)
)
pts1
)
)
)
(xd::list:removedup (mapcar
'cadr
(xdrx_points_sortoncurve (list p1 p2)
(apply
'append
pts2
)
)
)
)
)

(defun XD::Pnts:Visible (pts p1 p2 / e ints ints1 pt1 pt2 pts1 pts2 ptss x y) 
  (defun _isInt (ptss pt1 pt2) 
    (vl-some '(lambda (x) 
                (xdrx_curve_getinters (list pt1 pt2) x) 
              ) ptss 
    ) 
  ) 
  (setq pts (xd::list:removedup pts)) 
  (setq pts1 (mapcar 
               '(lambda (x) 
                  (cond 
                    ((= (type x) 'ENAME) 
                      (xdrx_getpropertyvalue x "vertices") 
                    ) 
                    ((= (type x) 'LIST) 
                      x 
                    ) 
                  ) 
                ) 
               pts 
             ) 
  ) 
  (setq pts2 (vl-remove nil (mapcar 
                              '(lambda (x / e) 
                                 (setq e (xdrx_polyline_make x t)) 
                                 (setq ints1 nil) 
                                 (mapcar 
                                   '(lambda (y) 
                                      (if (setq pts2 
                                                (xd::pnts:orthoproject 
                                                                       (list y) 
                                                                       p1 p2 
                                                ) 
                                          ) 
                                        (progn 
                                          (if (setq ints 
                                                    (xdrx_curve_getinters 
                                                                          (list 
                                                                                (car pts2) y 
                                                                          ) 
                                                                          e 
                                                    ) 
                                              ) 
                                            (progn 
                                              (if (and 
                                                    (= (length ints) 1) 
                                                    (not (_isInt 
                                                                 (vl-remove x pts1) 
                                                                 (car pts2) 
                                                                 (car ints) 
                                                         ) 
                                                    ) 
                                                  ) 
                                                (setq ints1 (cons 
                                                                  (car ints) 
                                                                  ints1 
                                                            ) 
                                                ) 
                                              ) 
                                            ) 
                                          ) 
                                        ) 
                                      ) 
                                    ) 
                                   x 
                                 ) 
                                 (xdrx_entity_delete e) 
                                 (vl-remove nil (mapcar 
                                                  'cadr 
                                                  (xdrx_points_sortoncurve 
                                                                           (list p1 p2) ints1 
                                                  ) 
                                                ) 
                                 ) 
                               ) 
                              pts1 
                            ) 
             ) 
  ) 
  (xd::list:removedup (mapcar 
                        'cadr 
                        (xdrx_points_sortoncurve (list p1 p2) 
                                                 (apply 
                                                   'append 
                                                   pts2 
                                                 ) 
                        ) 
                      ) 
  ) 
)

csharp · 发表于 2016-5-30 20:27:58

用个 line 做投影代码简单了

wenyish · 发表于 2016-11-24 10:15:57

不知道怎样用法？

newer · 发表于 2016-11-24 10:29:29

wenyish 发表于 2016-11-24 10:15

这个是具体的应用（快速标注）： http://bbs.xdcad.net/thread-704484-1-1.html

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

[点表] (XD::Pnts:Visible)判断点表（多段线实体表）哪些点对一条直线可见

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