linhui12
发表于 2008-5-31 23:05:00
本帖最后由 作者 于 2008-6-1 12:44:23 编辑 <br /><br /> <font face="Verdana" color="#61b713"><strong>其实此程序与先前拜托"sailorcwx兄"写的"</strong><font face="Courier New" color="#800080" style="BACKGROUND-COLOR: #c0c0c0;">绘制双线管程序</font><strong>"是相结合的,也就是说数据中第一个是管线序号,第二个是M,第三个是R,第四个是N,由本题程序将数据提取赋值并通过坐标值的二维化转换,最后结合"</strong><font face="Courier New" color="#800080" style="BACKGROUND-COLOR: #c0c0c0;">绘制双线管程序</font><strong>"将所有的三维多段线都变成"双线管",这就是我最终的目的,请sailorcwx兄及各位朋友出出力帮忙完善,拜托了</strong></font>
linhui12
发表于 2008-6-2 07:22:00
<p>上班前一顶,期待您伸手相助......</p>
xxsheng
发表于 2008-6-2 15:23:00
本帖最后由 作者 于 2008-6-3 10:57:26 编辑 <br /><br /> 关闭!<br/>
linhui12
发表于 2008-6-2 18:40:00
<p>谢谢<font face="Verdana" color="#61b713"><strong>xxsheng<font color="#000000">兄的回帖,辛苦了</font></strong></font></p><p>可惜我是刚刚接触LISP,又是自学的,头都想大了,也不知道其余部分要如何去完整,好无助啊......</p>
xxsheng
发表于 2008-6-3 11:06:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br/>(defun c:draw ( / rcz cz startp f tmptxt tmp dh m r n plent oldosmode oldcmdecho startp numb)<br/> (prompt "\n此程序读取各行数据格式为:参数1,参数2,参数3,数学坐标X值,数学坐标Y值,Z值。")<br/> (setq oldosmode(getvar "osmode")<br/> oldcmdecho(getvar "cmdecho")<br/> )<br/> (setvar "osmode" 0)<br/> (setvar "cmdecho" 0)<br/> (setq f(getfiled "选取文件" " " "txt" 2))<br/> (prompt "\n正在读取文件中的数据...")<br/> (setq f(open f "r"))<br/> (while (setq tmptxt(read-line f))<br/> (cond<br/> ((setq tmp(read(strcat "(" (vl-string-translate "," " " tmptxt)")"))) (setq cz (cons tmp cz)))<br/> (t nil)<br/> )<br/> )<br/> (close f)<br/> (setq cz (reverse cz))<br/> ;;上面读取文件为表下面开始进行绘制准备和坐标点转换为平面------<br/> (if startp nil (setq startp '(-4200 0 0)))<br/> ;(setq rcz(mapcar 'cddddr cz));;去除前三个参数,只留下坐标点----<br/> (mapcar '(lambda(x)(setq dh(cons (car x) dh)<br/> m(cons (cadr x) m)<br/> r(cons (caddr x) r)<br/> n(cons (cadddr x) n)<br/> rcz(cons (cddddr x) rcz)<br/> ))cz)<br/> (setq dh(reverse dh)<br/> m(reverse m)<br/> r(reverse r)<br/> n(reverse n)<br/> rcz(reverse rcz)<br/> )<br/> ;;下面分离坐标出来--------------------------------------------<br/> (setq rcz(mapcar '(lambda(x)<br/> (if tmptxt (setq tmptxt nil))<br/> (while (setq tmptxt (cons (list (car x) (cadr x) (caddr x)) tmptxt)<br/> x (cdddr x)))<br/> (reverse tmptxt)<br/> ) rcz))<br/> (setq numb -1<br/> rcz(mapcar '(lambda(x)(setq numb(1+ numb))<br/> (if (and (zerop(rem numb 20)) (> numb 0))<br/> (setq startp (list 0 (- (cadr startp) 6800) 0))<br/> (setq startp (mapcar '+ startp '(4200 0 0))))<br/> (mattoplanar x startp))rcz)<br/> )<br/> (mapcar '(lambda(x)(apply 'command (append '("._3dpoly") x '("")))) rcz)<br/> (princ (strcat "\n总共生成" (itoa (1+ numb)) "条多段线!"))<br/> (setvar "osmode" oldosmode)<br/> (setvar "cmdecho" oldcmdecho)<br/> (princ)<br/>)<br/>;;点集进行平面化并且移动到指定位置-------<br/>(defun mattoplanar(plst movetopoint / m zdir vect1 vectdot rotatev vect1 tmp cosv tmp2 sinv rotatem<br/> nth0p vect2 norvect isplanar moveto)<br/> ;;首先判断点集是否共线-----------------<br/> (setq m(length plst)<br/> zdir '(0 0 1)<br/> nth0p (car plst)<br/> )<br/> (cond<br/> ((< m 2) plst);一个点直接返回该点----<br/> ((= m 2);;两个点,判断线--------------<br/> (setq vect1(mapcar '- (cadr plst) nth0p))<br/> (if (not (equal (setq vectdot(>&> vect1 zdir)) 0 1e-3))<br/> (progn;;线不在xy平面上------------<br/> (if (equal (setq rotatev(>*> vect1 zdir)) '(0 0 0) 1e-3)<br/> (progn;和z轴平行绕x轴或者y轴都可以,先假定绕x轴旋转---------------<br/> (setq vect1(list (car vect1) (- (caddr vect1)) (cadr vect1)))<br/> ;(setq plst(list (car plst) (mapcar '+ (car plst) vect1)));返回旋转后的点--<br/> (setq plst(list movetopoint (mapcar '+ startp vect1)))<br/> )<br/> (progn;不和z轴平行,计算旋转轴和旋转角度--------------------------<br/> (setq tmp(distance vect1 '(0 0 0)))<br/> (setq cosv(/ vectdot tmp))<br/> (setq tmp2(distance rotatev '(0 0 0)))<br/> (setq sinv(/ tmp2 tmp)) <br/> (setq rotatev(mapcar '(lambda(x)(/ x tmp2)) rotatev))<br/> (setq rotatem(rotatemat rotatev cosv sinv))<br/> (setq plst(list movetopoint (mapcar '+ startp (mapcar '(lambda(x)(>&> vect1 x)) rotatem))))<br/> )<br/> )<br/> )<br/> (setq plst (list movetopoint (mapcar '+ startp vect1)));在xy平面上,直接返回移动后的点--<br/> )<br/> )<br/> (t;多于等于三个点以上判断是否共面,如果共面生成旋转矩阵,然后进行坐标点转换--<br/> (setq vect1(mapcar '- (cadr plst) nth0p)<br/> vect2(mapcar '- (caddr plst) nth0p)<br/> norvect(>*> vect1 vect2)<br/> isplanar t<br/> tmp(cddr plst)<br/> moveto(mapcar '- movetopoint nth0p)<br/> )<br/> (while (and (setq tmp(cdr tmp)) isplanar)<br/> (if (equal (>&> (mapcar '- (car tmp) nth0p) norvect) 0 1e-3) nil (setq isplanar nil))<br/> )<br/> (if isplanar<br/> (progn;;所有点在同一个平面---------------------------------<br/> (if (not (equal (setq rotatev(>*> norvect zdir)) '(0 0 0) 1e-3))<br/> (progn;;不在xy平面上,生成矩阵--------------------------<br/> (setq tmp(distance norvect '(0 0 0))<br/> tmp2(distance rotatev '(0 0 0)))<br/> (setq cosv(/ (>&> norvect zdir) tmp))<br/> (setq sinv(/ tmp2 tmp))<br/> (setq rotatev(mapcar '(lambda(x)(/ x tmp2)) rotatev))<br/> (setq rotatem(rotatemat rotatev cosv sinv))<br/> (setq plst(mapcar '(lambda(x)<br/> (setq vect1(mapcar '- x nth0p))<br/> (mapcar '+ startp (mapcar '(lambda(x)(>&> vect1 x)) rotatem))) plst))<br/> )<br/> (setq plst(mapcar '(lambda(x) (mapcar '+ x moveto)) plst));在xy平面也移动到指定位置--<br/> )<br/> )<br/> (setq plst(mapcar '(lambda(x) (mapcar '+ x moveto)) plst));不在一个平面也移动到指定位置--<br/> ) <br/> )<br/> )<br/> plst<br/>)<br/>(defun >*>(>a >b / a1 a2 a3 b1 b2 b3)<br/> (setq a1(car >a)<br/> a2(cadr >a)<br/> a3(caddr >a)<br/> b1(car >b)<br/> b2(cadr >b)<br/> b3(caddr >b))<br/> (list (- (* a2 b3)(* a3 b2))<br/> (- (* a3 b1) (* a1 b3))<br/> (- (* a1 b2) (* a2 b1)))<br/>)<br/>(defun >&>(>a >b)<br/> (apply '+ (mapcar '* >a >b))<br/>)<br/>(defun r*mat(r mat)<br/> (mapcar '(lambda(x)(mapcar '(lambda(y)(* r y)) x))mat)<br/>)<br/>(defun mat+mat(lst1 lst2)<br/> (mapcar '(lambda(x y)(mapcar '(lambda(m n)(+ m n)) x y)) lst1 lst2)<br/>)<br/>(defun rotatemat(rvec cosv sinv / antimat t1 t2 t3)<br/> (setq antimat(list (list 0 (- (caddr rvec)) (cadr rvec))<br/> (list (caddr rvec) 0 (- (car rvec)))<br/> (list (- (cadr rvec)) (car rvec) 0))<br/> t1(list (list cosv 0 0)(list 0 cosv 0)(list 0 0 cosv))<br/> t2(r*mat (- 1 cosv) (mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) rvec)) rvec))<br/> t3(r*mat sinv antimat)<br/> t1(mat+mat t1 t2)<br/> t1(mat+mat t1 t3)<br/> )<br/>)<br/>;;如果位置摆放不合意,自己改变量startp,,很多东西还是得靠自己,本人能力有限.还是不行就只好等待高手来帮你解决了.<br/>
linhui12
发表于 2008-6-3 21:37:00
<p><font face="Verdana" color="#61b713"><strong>感谢"xxsheng"兄的回复和无私帮助,谢谢您,程序已经能满足在下册需要了,谢谢</strong></font></p><p><font face="Verdana" color="#61b713"><strong>"sailorcwx兄"兄,通过"xxsheng"的以上程序我们就可以得到</strong><strong>数据中第一个是管线序号,第二个是M,第三个是R,第四个是N,麻烦您最后结合"</strong><font face="Courier New" color="#800080" style="BACKGROUND-COLOR: #c0c0c0;">绘制双线管程序</font><strong>"将所有的三维多段线都变成"双线管",请sailorcwx兄及各位朋友出出力帮忙完善,因为"</strong><font face="Courier New" color="#800080" style="BACKGROUND-COLOR: #c0c0c0;">绘制双线管程序</font><strong>"是sailorcwx兄写的,请您通过以上求出的M,R,N值,对程序加以调整将所有的多段线以"</strong><font face="Courier New" color="#800080" style="BACKGROUND-COLOR: #c0c0c0;">双线管</font><strong>"形式显示.拜托了.</strong></font></p>
linhui12
发表于 2008-6-5 12:41:00
<p>sailorcwx兄,您好.</p><p>由于绘图那部分软件原型是您编的,在下不好求助于他人.我知道此程序之前就费了您不少工夫.但现在只差一点了,将数据读取转换模块与您的程序衔接起来.不知是否愿意出手相助,帮忙完善.</p><p>在下毕竟也是堂堂七尺男儿,如果您确实没时间或不愿意出手,也请明示!!!倘若您不愿意帮忙我还天天顶帖求您...也怪不好意思的.那我也只好作罢不再强求了.</p>
sailorcwx
发表于 2008-6-5 14:13:00
<p>网速慢，没留意</p><p></p>
sailorcwx
发表于 2008-6-5 14:18:00
本帖最后由 作者 于 2008-6-5 14:20:41 编辑 <br /><br /> <p>用法</p><p><strong><font face="Courier New" color="#0000ff">(drawpipers M R N 点坐标串列)</font></strong></p><p><strong><font face="Courier New" color="#0000ff"></font></strong></p><p></p>
linhui12
发表于 2008-6-5 19:27:00
sailorcwx兄,您终于出现了.请问我要把您这个"<strong><font face="Courier New" color="#0000ff">drawpipers</font></strong>"函数添加到以上程序的哪部分里去呢,我是无从下手啊,还望明示.谢谢