[编程申请]：请大家帮忙解决一下这个问题
本帖最后由 作者 于 2003-12-30 13:33:59 编辑;;BY龙龙仔(LUCAS)
;;这样会快一点
(defun C:GETPT_LAI (/ SS N P1 P2 PT_LIST PT_LIST1 LEN)
(setq SS (ssget '((0 . "*POLYLINE"))))
(if SS
(progn
(setq N 0
LEN (sslength SS)
)
(repeat LEN
(setq PT_LIST (append PT_LIST (GETLISTOFPLINE (ssname SS N))))
(setq N (1+ N))
)
(setq
PT_LIST
(vl-sort PT_LIST
(function (lambda (P1 P2)
(cond ((< (car P1) (car P2)) t)
((and (= (car P1) (car P2))
(< (cadr P1) (cadr P2))
)
t
)
(t NIL)
)
)
)
)
)
(setq N 0
LEN (- (length PT_LIST) 1)
)
(repeat LEN
(if (and (equal (nth N PT_LIST) (nth (1+ N) PT_LIST))
(not (member (nth N PT_LIST) PT_LIST1))
)
(setq PT_LIST1 (append PT_LIST1 (list (nth N PT_LIST))))
)
(setq N (1+ N))
)
PT_LIST1
)
)
)
以上是龙斑竹给我写的一个程序，请大家根据这个帮我编一个程序
要求
1线是3dpoly
2当两条线相交的时候必须有相同的节点。
3可以对多根线进行选择。
4要在两条线没有交点的地方在交点处进行标注。
具体要求请看一下文件 4要在两条线没有交点的地方在交点处进行标注。
没有交点哪儿来的交点处？ 还有一个小问题，就是你自己的获得POLYLINE顶点的程序，是去掉Z坐标的，这样如果两条线并不相交，但从视觉上是相交的（就是高度不同），这样也算是相交吗？ 原来我说话这么不严密，可能是知识有限。
不能去掉Z坐标，不能视觉
应该节点高度相同 程序如下，你可以修改Mark函数来修改你想要的标注样子，参数为：
pts_r 正确的交点
pts_w 错误的交点
(defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
(setq ax_ent_1 (vlax-ename->vla-object ent1)
ax_ent_2 (vlax-ename->vla-object ent2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)))
)
(setq i (+ 3 i))
)
)
points
)
(defun GetAllInters(ss / ss n i j ent1 ent2 points)
(setq n (sslength ss))
(setq i 0 j 0)
(while (< i n)
(setq j (1+ i))
(setq ent1 (ssname ss i))
(while (< j n)
(setq ent2 (ssname ss j))
(setq points (append points (getinterpoint ent1 ent2)))
(setq j (1+ j))
)
(setq i (1+ i))
)
points
)
(defun setcolor(sname color / sinf)
(setq sinf (entget sname))
(if (assoc 62 sinf)
(setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
(setq sinf (append sinf (list (cons 62 color))))
)
(entmod sinf)
)
(defun GetListOfPline (EntityName / SSE_Pline N newEntityName LastList)
(setq SSE_Pline (entget EntityName))
(setq LastList nil)
(if (= (cdr (ASSOC 0 SSE_Pline)) "POLYLINE")
(PROGN
(setq newEntityName (entnext EntityName))
(while (= (cdr (assoc 0 (entget newEntityName))) "VERTEX")
(setq
LastList (append
LastList
(list (cdr (assoc 10 (entget newEntityName))))
)
)
(setq newEntityName (entnext newEntityName))
)
)
)
LastList
) ;_defun
(defun Mark (pts_r pts_w / i)
(setq i 0)
(repeat (length pts_r)
(command "_.circle" (nth i pts_r) 2.5)
(setcolor (entlast) 1)
(setq i (1+ i))
)
(setq i 0)
(repeat (length pts_w)
(command "_.circle" (nth i pts_w) 2.5)
(setcolor (entlast) 2)
(setq i (1+ i))
)
)
(defun main( / ss n len pt_list pts_r pts_w i pt)
(setq ss (ssget '((0 . "POLYLINE"))))
(if SS
(progn
(setq N 0
LEN (sslength SS)
)
(repeat LEN
(setq PT_LIST (append PT_LIST (GETLISTOFPLINE (ssname SS N))))
(setq N (1+ N))
)
(setq pts (getallinters ss))
(setq n 0)
(repeat (length pts)
(setq pt (nth n pts))
(if (>= (- (length pt_list) (length (vl-remove pt pt_list))) 2)
(if (not (member pt Pts_r))
(setq Pts_r (append Pts_r (list pt)))
)
(if (not (member pt pts_w))
(setq Pts_W (append Pts_w (list pt)))
)
)
(setq n (1+ n))
)
(Mark pts_r pts_w)
)
)
(princ)
)
(defun err (msg)
(princ msg)
(command "_.undo" "e")
(setq *error* errtmp)
(setvar "cmdecho" cmd)
(setvar "osmode" os)
(princ)
)
(defun c:getpt()
(setq os (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq errtmp *error*)
(setq *error* err)
(command "_.undo" "be")
(main)
(command "_.undo" "e")
(setq *error* errtmp)
(setvar "cmdecho" cmd)
(setvar "osmode" os)
(princ)
) 感谢 meflying 斑竹的热心帮忙
谢谢您了
特献上鲜花一朵
页:
[1]