[求助]：[0331]XLINE转LINE问题

tctabc

[求助]：[0331]XLINE转LINE问题

小弟想写各将XLINE转LINE的程序,
但由于用到VLISP 对此不熟析,
以下是我的程序,

在执行中的这段
(setq pt:2 (vla-IntersectWith xobj le:ri acExtendNone ))
(setq pt:ri (VLAX-SAFEARRAY->LIST (VLAX-variant-value pt:2)) )

会出现以下讯息而中断,不知道该怎样解决.
#<variant 8197 ...>
[ActiveX 伺服器回覆一个错误讯息: 无效的索引。]

另外就该怎样判断此线有碰撞到的两点
好让这两点可以成一线呢?

烦请各位高手可以解答一下
谢谢~

(defun scvp (/ c03 c08 c04 c05 c07 c06 c09 c01 c02)
(setq c03 (getvar "viewctr")
c03 (trans c03 1 2)
c08 (getvar "viewsize")
c04 (getvar "screensize")
c07 (car c04)
c06 (cadr c04)
c09 (/ (* c08 c07) c06)
c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))
c01 (trans c01 2 1)
c02 (trans c02 2 1))
(list c01 c02)
)
 
(setq en  (car (entsel "\n 选择物件:")))
(setq xobj (vlax-ename->vla-object en))
 
(setq box (scvp))
(setq box4x (car (setq box1 (nth 0 box)))) ;左下
(setq box4y (cadr (setq box3 (nth 1 box)))) ;右上
(setq box2x (car (setq box3 (nth 1 box))))
(setq box2y (cadr (setq box1 (nth 0 box)))) 
(setq box4 (list box4x box4y )) ;左上
(setq box2 (list box2x box2y )) ;右下
(command "_.line" box1 box2 "")
(setq le:dn (vlax-ename->vla-object (entlast)))
(command "_.line" box2 box3 "")
(setq le:ri (vlax-ename->vla-object (entlast)))
(command "_.line" box3 box4 "")
(setq le:up (vlax-ename->vla-object (entlast)))
(command "_.line" box4 box1 "")
(setq le:le (vlax-ename->vla-object (entlast)))
 
(setq pt:1 (vla-IntersectWith xobj le:dn acExtendNone ))
(setq pt:dn (VLAX-SAFEARRAY->LIST (VLAX-variant-value pt:1)) )

(setq pt:2 (vla-IntersectWith xobj le:ri acExtendNone ))
(setq pt:ri (VLAX-SAFEARRAY->LIST (VLAX-variant-value pt:2)) )
 
(setq pt:3 (vla-IntersectWith xobj le:up acExtendNone ))
(setq pt:up (VLAX-SAFEARRAY->LIST (VLAX-variant-value pt:3)) )
 
(setq pt:4 (vla-IntersectWith xobj le:le acExtendNone ))
(setq pt:le (VLAX-SAFEARRAY->LIST (VLAX-variant-value pt:4)) )
 
(entdel le:dn)
(entdel le:ri)
(entdel le:up)
(entdel le:le)

=> 判断并取出有相交的两点 [不知道怎样判断取出?]
=> 重新绘制两点的LINE
=> END

龙龙仔

3. (defun C:TT (/ BOX EN LE:DN PT:1 PT:DN XOBJ)
4.   (setq EN (car (entsel "\n 选择物件:")))
5.   (setq XOBJ (vlax-ename->vla-object EN))
6.   (setq BOX (SCVP))
7.   (command "_.rectang" (nth 0 BOX) (nth 1 BOX))
8.   (setq LE:DN (vlax-ename->vla-object (entlast)))
9.   (setq PT:1 (vla-intersectwith XOBJ LE:DN acextendnone))
10.   (setq PT:DN (vlax-safearray->list (vlax-variant-value PT:1)))
11.   (vla-delete LE:DN)
12.   (vla-delete XOBJ)
13.   (command "_.LINE"
14.     "non"
15.     (list (nth 0 PT:DN) (nth 1 PT:DN) (nth 2 PT:DN))
16.     "non"
17.     (list (nth 3 PT:DN) (nth 4 PT:DN) (nth 5 PT:DN))
18.     ""
19.   )
20.   (princ)
21. )

(defun C:TT (/ BOX EN LE:DN PT:1 PT:DN XOBJ)   (setq EN (car (entsel "\n 选择物件:")))   (setq XOBJ (vlax-ename->vla-object EN))   (setq BOX (SCVP))   (command "_.rectang" (nth 0 BOX) (nth 1 BOX))   (setq LE:DN (vlax-ename->vla-object (entlast)))   (setq PT:1 (vla-intersectwith XOBJ LE:DN acextendnone))   (setq PT:DN (vlax-safearray->list (vlax-variant-value PT:1)))   (vla-delete LE:DN)   (vla-delete XOBJ)   (command "_.LINE"     "non"     (list (nth 0 PT:DN) (nth 1 PT:DN) (nth 2 PT:DN))     "non"     (list (nth 3 PT:DN) (nth 4 PT:DN) (nth 5 PT:DN))     ""   )   (princ) )

tctabc

感谢版大的解答

谢谢您了

894560869

麻烦您可不可以改多框选