[讨论]怎么样解决这个循环问题

lzy9788

我想用下面的程序剪断相交梁线，达到右图效果，如图所示 （如果我还想让红线内的线倒角闭合有什么方法吗） (setq #floor_no "1")
(defun C:111 ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(setq oldpickbox (getvar "pickbox"))
(setq no (getstring (strcat "\n将要修改的结构层号是<第" #floor_no "层结构平面>:")))
(if (/= no "") (setq #floor_no no) (setq no #floor_no))
(setq lay1 (strcat #floor_no "_grid")
lay2 (strcat #floor_no "_beam")
lay3 (strcat #floor_no "_bar"))
(trr2)
(command "_.undo" "e")
(setvar "cmdecho" 1)
);end defun (defun trr2 ()
(setvar "osmode" 0)
(setq pt1 (getpoint "\n梁相交处自动剪断-VER 1.0.(若两梁线间距小于等于450mm时不能用)!\n框选第一点:"))
(if (= pt1 nil) ((setvar "pickbox" oldpickbox) (exit)))
(setq pt2 (getcorner pt1 "\n框选第二点:"))
(setq ss (ssget "c" pt1 pt2 (list (cons 8 lay2))))
(command "change" ss "" "p" "lt" "continuous" "")
(setq num (sslength ss) ee 0)
(setq p_10_11_list nil)
(while (< ee num)
(setq nam (ssname ss ee)
ent (entget nam)
p_10 (list (cdr (assoc 10 ent)))
p_11 (list (cdr (assoc 11 ent)))
);end setq
(setq p_10_11_list (append p_10 p_10_11_list))
(setq p_10_11_list (append p_11 p_10_11_list))
(setq ee (1+ ee))
);end while
(vl-load-com)

(intquyu) (setvar "osmode" 0)
(setvar "pickbox" 0) (setq num_pts (length pts) nn 0 pts_near nil) (while (< nn num_pts)
(setq pts_re (nth nn pts) pts_near (list pts_re))
(setq mm 1)
(while (< mm num_pts)
(setq dis_pts (distance pts_re (nth mm pts)))
(if (<= dis_pts 450)
(setq pts_near (append (list (nth mm pts)) pts_near))
)
(setq mm (1+ mm))
);end while (setq num_pts_near (length pts_near) num_aa 0) (while (< num_aa num_pt_near)
(setq pts (vl-remove (list (nth num_aa pts_near)) pts))
(setq num_aa (1+ num_aa))
)
(setq num_pts (length pts))
(cond
((= num_pts_near 4)
(setq pts_1
(vl-sort pts_near
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) );按Y坐标排序(小到大)
);;end setq
(setq pts-1 (nth 0 pts_1) pts-2 (nth 1 pts_1))
(setq pts-3 (nth 2 pts_1) pts-4 (nth 3 pts_1)) (setq lis_1
(vl-sort (list pts-1 pts-2)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-1 (nth 0 lis_1) p-2 (nth 1 lis_1))
(setq lis_2
(vl-sort (list pts-3 pts-4)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-4 (nth 0 lis_2) p-3 (nth 1 lis_2))
(setq mid1 (polar p-1 (angle p-1 p-2) (* (distance p-1 p-2) 0.25))
mid2 (polar p-2 (angle p-2 p-3) (* (distance p-2 p-3) 0.25))
mid3 (polar p-3 (angle p-3 p-4) (* (distance p-3 p-4) 0.25))
mid4 (polar p-4 (angle p-4 p-1) (* (distance p-4 p-1) 0.25))
)
(command "trim" ss "" mid1 mid2 mid3 mid4 "")
);cond 1 ((= num_pts_near 2)
(setq num_p_10_11_list (length p_10_11_list) nn_2 0)
(while (< nn_2 num_p_10_11_list)
(setq dis_2 (distance (nth 0 pts_near) (nth nn_2 p_10_11_list)))
(if (<= dis_pts 450) (setq pts_near (append (list (nth nn_2 p_10_11_list)) pts_near)))
(setq nn_2 (1+ nn_2))
);end while (setq pts_1
(vl-sort pts_near
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) );按Y坐标排序(小到大)
);;end setq
(setq pts-1 (nth 0 pts_1) pts-2 (nth 1 pts_1))
(setq pts-3 (nth 2 pts_1) pts-4 (nth 3 pts_1)) (setq lis_1
(vl-sort (list pts-1 pts-2)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-1 (nth 0 lis_1) p-2 (nth 1 lis_1))
(setq lis_2
(vl-sort (list pts-3 pts-4)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-4 (nth 0 lis_2) p-3 (nth 1 lis_2))
(setq mid1 (polar p-1 (angle p-1 p-2) (* (distance p-1 p-2) 0.25))
mid2 (polar p-2 (angle p-2 p-3) (* (distance p-2 p-3) 0.25))
mid3 (polar p-3 (angle p-3 p-4) (* (distance p-3 p-4) 0.25))
mid4 (polar p-4 (angle p-4 p-1) (* (distance p-4 p-1) 0.25))
)
(command "trim" ss "" mid1 mid2 mid3 mid4 "")
);cond 2
;
; ((= num_pts_near 1)
;
; );cond 3
);cond
;(setq nn (1+ nn))
);end while
(setq ss1 (ssget "c" pt1 pt2 (list (cons 8 lay2))))
(command "change" ss1 "" "p" "lt" "bylayer" "")
(setvar "pickbox" oldpickbox)
(setvar "OSMODE" 759)
) (defun intquyu (/ SSL ;length of SS
; PTS ;returning list
AOBJ1 ;Object 1
AOBJ2 ;Object 2
N1 ;Loop counter
N2 ;Loop counter
IPTS ;intersects
A N NN HOLDOSMODE
)
(vl-load-com)
(setq pts nil)
;;; (command "_.UNDO" "_GROUP")
;;; (setq HOLDOSMODE (getvar "OSMODE"))
;;; (setvar "OSMODE" 0)
;;; (setq SS (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(setq N1 0 ;index for outer loop
SSL (sslength SS)
) ; Outer loop, first through second to last
(while (< N1 (1- SSL)) ; Get object 1, convert to VLA object type
(setq AOBJ1 (ssname SS N1)
AOBJ1 (vlax-ename->vla-object AOBJ1)
N2 (1+ N1)
) ;index for inner loop
;;; Inner loop, go through remaining objects
(while (< N2 SSL) ; Get object 2, convert to VLA object
(setq AOBJ2 (ssname SS N2)
AOBJ2 (vlax-ename->vla-object AOBJ2)
;;;Find intersections of Objects
IPTS (vla-intersectwith
AOBJ1
AOBJ2
0
) ; variant result
IPTS (vlax-variant-value IPTS)
)
;;;Variant array has values?
(if (> (vlax-safearray-get-u-bound IPTS 1) 0)
(progn ;array holds values, convert it
(setq IPTS ;to a list.
(vlax-safearray->list IPTS)
)
;;;Loop through list constructing points
(while (> (length IPTS) 0)
(setq PTS (cons (list (car IPTS)
(cadr IPTS)
(caddr IPTS)
)
PTS
)
IPTS (cdddr IPTS)
)
)
)
)
(setq N2 (1+ N2))
) ;inner loop end
(setq N1 (1+ N1))
) ;outer loop end
;;; (princ PTS)(princ)
;;; (setvar "OSMODE" HOLDOSMODE)
;;; (command "_.UNDO" "_END")
;;; (princ)
);end defun

lzy9788

现在是循环有问题

lzy9788

哪位大哥能搞定吗

meflying

你程序里有好多循环,是哪里不对,又是有什么问题?


每次最好把问题说清楚一点,越详细越好,否则你每发一个程序,别人都要从头到尾给你看明白了...

yxp

就是也只有meflying才有这个耐心,你能指望谁给你免费看这大一段程序.

lzy9788

这个有问题： (while (< nn num_pts)
(setq pts_re (nth nn pts) pts_near (list pts_re))
(setq mm 1)
(while (< mm num_pts)
(setq dis_pts (distance pts_re (nth mm pts)))
(if (<= dis_pts 450)
(setq pts_near (append (list (nth mm pts)) pts_near))
)
(setq mm (1+ mm))
);end while (setq num_pts_near (length pts_near) num_aa 0) (while (< num_aa num_pt_near)
(setq pts (vl-remove (list (nth num_aa pts_near)) pts))
(setq num_aa (1+ num_aa))
)
(setq num_pts (length pts))
(cond
((= num_pts_near 4)
(setq pts_1
(vl-sort pts_near
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) );按Y坐标排序(小到大)
);;end setq
(setq pts-1 (nth 0 pts_1) pts-2 (nth 1 pts_1))
(setq pts-3 (nth 2 pts_1) pts-4 (nth 3 pts_1)) (setq lis_1
(vl-sort (list pts-1 pts-2)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-1 (nth 0 lis_1) p-2 (nth 1 lis_1))
(setq lis_2
(vl-sort (list pts-3 pts-4)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-4 (nth 0 lis_2) p-3 (nth 1 lis_2))
(setq mid1 (polar p-1 (angle p-1 p-2) (* (distance p-1 p-2) 0.25))
mid2 (polar p-2 (angle p-2 p-3) (* (distance p-2 p-3) 0.25))
mid3 (polar p-3 (angle p-3 p-4) (* (distance p-3 p-4) 0.25))
mid4 (polar p-4 (angle p-4 p-1) (* (distance p-4 p-1) 0.25))
)
(command "trim" ss "" mid1 mid2 mid3 mid4 "")
);cond 1 ((= num_pts_near 2)
(setq num_p_10_11_list (length p_10_11_list) nn_2 0)
(while (< nn_2 num_p_10_11_list)
(setq dis_2 (distance (nth 0 pts_near) (nth nn_2 p_10_11_list)))
(if (<= dis_pts 450) (setq pts_near (append (list (nth nn_2 p_10_11_list)) pts_near)))
(setq nn_2 (1+ nn_2))
);end while (setq pts_1
(vl-sort pts_near
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2)) ) ) );按Y坐标排序(小到大)
);;end setq
(setq pts-1 (nth 0 pts_1) pts-2 (nth 1 pts_1))
(setq pts-3 (nth 2 pts_1) pts-4 (nth 3 pts_1)) (setq lis_1
(vl-sort (list pts-1 pts-2)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-1 (nth 0 lis_1) p-2 (nth 1 lis_1))
(setq lis_2
(vl-sort (list pts-3 pts-4)
(function (lambda (e1 d2)
(< (car e1) (car e2)) ) ) ) );按X坐标排序(小到大)
(setq p-4 (nth 0 lis_2) p-3 (nth 1 lis_2))
(setq mid1 (polar p-1 (angle p-1 p-2) (* (distance p-1 p-2) 0.25))
mid2 (polar p-2 (angle p-2 p-3) (* (distance p-2 p-3) 0.25))
mid3 (polar p-3 (angle p-3 p-4) (* (distance p-3 p-4) 0.25))
mid4 (polar p-4 (angle p-4 p-1) (* (distance p-4 p-1) 0.25))
)
(command "trim" ss "" mid1 mid2 mid3 mid4 "")
);cond 2
;
; ((= num_pts_near 1)
;
; );cond 3
);cond
;(setq nn (1+ nn))
);end while
大侠运行下看，提示的是参数错误，三维点错误。 我求出了所有交点，通过程序剪断梁线相交处的多余线，（两线距离小于450时） 我找到距离一点小于450mm的四个点或三个点或两个点（如图梁交线）,将其组成一 列表，然后剪去列表点间的线，现在程序执行后只能剪掉一处，即循环不能进行下去，请大侠看看

meflying

程序倒是毫不吝啬,贴这么多,图为什么不贴个DWG可用的呢?


提问的也要动动脑筋...怎样才能让别人更能了解你的意思,要站在别人角度去想一下,要知道,别人对你做的东西可能一无所知...

lzy9788

就上面的那个图片

redearth

E:\ccc\2\dcl\diala3.sld

redearth

E:\谢雨欣\track01.mp3[/rm]