|
|
上次你给我写的连接六个点的程序，当出现6个点对称分布在两个相对边时，连线方法不能满足所需要求，请你再帮忙看一下!
以下是我说我情况的一种，请运行看一下，中间哪条线按要求应该是正交的。谢谢!
(vl-load-com)
(defun c:test( / ent ptLst ptLstc ptLstn pt ptn pti pta j i n dist l lMax)
(setq pt1 '(0 200 200) pt2 '(0 600 200) pt3 '(0 1200 200) pt4 '(3200 900 200) pt5 '(3200 1800 200) pt6 '(3200 1300 200) )
(setq ptc1 '(0 2000 200) )
(setq ptc2 '(3200 2000 200) )
(setq ptc3 '(3200 0 200) )
(setq ptc4 '(0 0 200) )
(command "rectang" ptc1 ptc3 "")
(setq ent (entlast))
;*****获取6个点和四个角点部分,根据需要,自己改成你自己的代码******
(setq ptLst (list pt1 pt2 pt3 pt4 pt5 pt6))
(setq ptLstc (list ptc1 ptc2 ptc3 ptc4))
;****************************************************************
(setq ptLst (mapcar '(lambda(x) (list (vlax-curve-getDistAtPoint ent x) x)) ptLst))
(setq ptLst (vl-sort ptLst '(lambda (x1 x2) ( lMax l)
(progn
(setq n (vl-position lMax dist))
(repeat (1+ n)
(setq ptLst (reverse (cons (car ptLst) (reverse (cdr ptLst)))))
)
)
)
(setq ptLst (mapcar 'cadr ptLst))
(setq i 0)
(repeat (1- (length ptLst))
(setq pt (nth i ptLst))
(setq ptn (nth (1+ i) ptLst))
(setq ptLstn (append ptLstn (list pt)))
(setq j 0)
(setq m t)
(while m
(setq pti (nth j ptLstc))
(cond
((> (vlax-curve-getDistAtPoint ent pt)
(vlax-curve-getDistAtPoint ent ptn))
(if (equal (vlax-curve-getStartPoint ent) pti 0.001)
(setq ptLstn (append ptLstn (list pti)))
)
)
(( (vlax-curve-getDistAtPoint ent pti) (vlax-curve-getDistAtPoint ent pt))
( j 3) (setq m nil))
)
(setq i (1+ i))
)
(setvar "osmode" 0)
;(command "linetype" "s" "xx" "")
(command "color" 170 "")
(command "_.pline")
(mapcar 'command ptLstn)
(command (last ptLst) "")
(command "color" "bylayer" "")
;(command "linetype" "s" "bylayer" "")
(command "erase" ent "")
) |
|
置顶卡
