[讨论]：[0316]延伸侦测可能实现吗?

tctabc

[讨论]：[0316]延伸侦测可能实现吗?

假如我在点选画面后,
做8各方向的延伸线,当直线延伸后,
经过的物件,或是设定的条件,
都会留下经过点的位置,
这样的作法,
该怎样去实现呢?

烦请各位高手解答一下~
谢谢!!!
0316-B-01-.jpg

zhang8755

有难度，初步的思路是用通过点选位置的线段进行压选获得一个和直线有交点的选择集，在逐个获得每一个交点。大家讨论看看是否可行。。

dandee

没 有 难 度 ， 8 个方 向  只 是 繁 琐一 点
方 法
1； 用 ( ssget "c" 两 点 ‘(0 .line))
两 点就 是 一 个 方 向 线 的 起 点 和 终 点 ,  只 过 滤 出 方 向 线 经 过 所 有的 直 线 (这 样 你 不 需 画 出 方 向 线 ， 只 给 出 两 点 就 可 以 了 )
2； 作 循 环 ----方 向 线 的 两 点 于 每 一 条 直 线 相 交 时 的 交 点
(inters p1 p2  p3  p4)

3； 要 注 意 的 是
8 条 方 向 线 的 范 围 需 在 acad的 图 形 的 视 觉 范 围 里， 如 果 在 视 觉 范 围 外 ， 可 能 就 无 法 用 ssget判 断 ， 可 以 用 zoom先 固 定 下 范 围

snoopychen

借用别人的子程序，加多几句话
如下
[php]
;;主程序，一点点作用而已
;;平台:acad2000以上
(defun c:test(/ point0 vs r i point1 pvlist)
(setq point0 (getpoint "the original point"))
(setq vs (getvar "viewsize"))
(setq r (* 0.01 vs))
(setq i 0)
(repeat 8
(setq point1 (polar point0 (* pi 0.25 i)1000000))
(setq pvlist (vl-Get-Int-Pt point0 point1))
(foreach x pvlist
(entmake (list (cons 0 "CIRCLE") (cons 62 1) (cons 10 x)(cons 40 r)))
)
(setq i (1+ i))
)
)




;;; 以下所有子程序引用一个韩国朋友写的关于两点和多个物体交点的程序
(defun vl-Get-Int-Pt (FirstPoint SecondPoint / acadDocument mSpace SSetName
                                 SSets SSet reapp ex obj Baseline
                     )
  (vl-load-com)
  (setq acadDocument (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  (setq SSetName "MySSet")
  (setq SSets (vla-get-SelectionSets acadDocument))
  (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-add (list SSets
                                                               SSetName
                                                         )
                            )
      )
    (vla-clear (vla-Item SSets SSetName))
  )
  (setq SSet (vla-Item SSets SSetName))
  (setq Baseline (vla-Addline mspace (vlax-3d-point FirstPoint)
                              (vlax-3d-point SecondPoint)
                 )
  )
  (vla-SelectByPolygon SSet acSelectionSetFence
                       (kht:list->safearray (append
                                              FirstPoint
                                              SecondPoint
                                            ) 'vlax-vbdouble
                       )
  )
  (vlax-for obj sset (if (setq ex (kht-intersect
                                                 (vlax-vla-object->ename BaseLine)
                                                 (vlax-vla-object->ename obj)
                                  )
                         )
                       (setq reapp (append
                                     reapp
                                     ex
                                   )
                       )
                     )
  )
  (vla-delete BaseLine)
  (setq reapp (vl-sort reapp '(lambda (e1 e2)
                                (< (car e1) (car e2))
                              )
              )
  )
  reapp
)


;;; 修改了一点，让text和其他的没有交点
(defun kht-intersect (en1 en2 / a b x ex ex-app c d e)
  (vl-load-com)
  (setq c (cdr (assoc 0 (entget en1)))
        d (cdr (assoc 0 (entget en2)))
  )
  (if (or
        (= c "TEXT")
        (= d "TEXT")
      )
    (setq e -1)
  )
  (setq En1 (vlax-ename->vla-object En1))
  (setq En2 (vlax-ename->vla-object En2))
  (setq a (vla-intersectwith en1 en2 acExtendNone))
  (setq a (vlax-variant-value a))
  (setq b (vlax-safearray-get-u-bound a 1))
  (if (= e -1)
    (setq b e)
  )
  (if (/= b -1)
    (progn
      (setq a (vlax-safearray->list a))
      (repeat (/ (length a) 3)
        (setq ex-app (append
                       ex-app
                       (list (list (car a) (cadr a) (caddr a)))
                     )
        )
        (setq a (cdr (cdr (cdr a))))
      )
      ex-app
    )
    nil
  )
)

(defun kht:list->safearray (lst datatype)
  (vlax-safearray-fill (vlax-make-safearray (eval datatype) (cons 0
                                                                  (1-
                                                                      (length lst)
                                                                  )
                                                            )
                       ) lst
  )
)

[/php]

LADESIGNER

即使可行速度也会很慢。

xyz518mm

請問關於 zoom 怎樣固定範圍呢?
是否要先取得螢幕範圍呢?