TO:"sailorcwx"兄和"xxsheng兄"程序OK,大恩不言谢啦!!!

linhui12

其实此程序与先前拜托"sailorcwx兄"写的"绘制双线管程序"是相结合的,也就是说数据中第一个是管线序号,第二个是M,第三个是R,第四个是N,由本题程序将数据提取赋值并通过坐标值的二维化转换,最后结合"绘制双线管程序"将所有的三维多段线都变成"双线管",这就是我最终的目的,请sailorcwx兄及各位朋友出出力帮忙完善,拜托了

linhui12

上班前一顶,期待您伸手相助......

xxsheng

关闭!

linhui12

谢谢xxsheng兄的回帖,辛苦了

可惜我是刚刚接触LISP,又是自学的,头都想大了,也不知道其余部分要如何去完整,好无助啊......

xxsheng

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:draw ( / rcz cz startp f tmptxt tmp dh m r n plent oldosmode oldcmdecho startp numb)
  (prompt "\n此程序读取各行数据格式为:参数1,参数2,参数3,数学坐标X值,数学坐标Y值,Z值。")
  (setq oldosmode(getvar "osmode")
    oldcmdecho(getvar "cmdecho")
    )
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (setq f(getfiled "选取文件" " " "txt" 2))
  (prompt "\n正在读取文件中的数据...")
  (setq f(open f "r"))
  (while (setq tmptxt(read-line f))
    (cond
      ((setq tmp(read(strcat "(" (vl-string-translate "," " " tmptxt)")"))) (setq cz (cons tmp cz)))
      (t nil)
    )
  )
  (close f)
  (setq cz (reverse cz))
  ;;上面读取文件为表下面开始进行绘制准备和坐标点转换为平面------
  (if startp nil (setq startp '(-4200 0 0)))
  ;(setq rcz(mapcar 'cddddr cz));;去除前三个参数,只留下坐标点----
  (mapcar '(lambda(x)(setq dh(cons (car x) dh)
               m(cons (cadr x) m)
               r(cons (caddr x) r)
               n(cons (cadddr x) n)
               rcz(cons (cddddr x) rcz)
               ))cz)
  (setq dh(reverse dh)
    m(reverse m)
    r(reverse r)
    n(reverse n)
    rcz(reverse rcz)
    )
  ;;下面分离坐标出来--------------------------------------------
  (setq rcz(mapcar '(lambda(x)
         (if tmptxt (setq tmptxt nil))
         (while (setq tmptxt (cons (list (car x) (cadr x) (caddr x)) tmptxt)
                  x (cdddr x)))
         (reverse tmptxt)
         ) rcz))
  (setq numb -1
    rcz(mapcar '(lambda(x)(setq numb(1+ numb))
              (if (and (zerop(rem numb 20)) (> numb 0))
            (setq startp (list 0 (- (cadr startp) 6800) 0))
            (setq startp (mapcar '+ startp '(4200 0 0))))
              (mattoplanar x startp))rcz)
    )
  (mapcar '(lambda(x)(apply 'command (append '("._3dpoly") x '("")))) rcz)
  (princ (strcat "\n总共生成" (itoa (1+ numb)) "条多段线!"))
  (setvar "osmode" oldosmode)
  (setvar "cmdecho" oldcmdecho)
  (princ)
)
;;点集进行平面化并且移动到指定位置-------
(defun mattoplanar(plst movetopoint / m zdir vect1 vectdot rotatev vect1 tmp cosv tmp2 sinv rotatem
                                nth0p vect2 norvect isplanar moveto)
  ;;首先判断点集是否共线-----------------
  (setq m(length plst)
    zdir '(0 0 1)
    nth0p (car plst)
    )
  (cond
    ((< m 2) plst);一个点直接返回该点----
    ((= m 2);;两个点,判断线--------------
     (setq vect1(mapcar '- (cadr plst) nth0p))
     (if (not (equal (setq vectdot(>&> vect1 zdir)) 0 1e-3))
       (progn;;线不在xy平面上------------
     (if (equal (setq rotatev(>*> vect1 zdir)) '(0 0 0) 1e-3)
       (progn;和z轴平行绕x轴或者y轴都可以,先假定绕x轴旋转---------------
         (setq vect1(list (car vect1) (- (caddr vect1)) (cadr vect1)))
         ;(setq plst(list (car plst) (mapcar '+ (car plst) vect1)));返回旋转后的点--
         (setq plst(list movetopoint (mapcar '+ startp vect1)))
       )
       (progn;不和z轴平行,计算旋转轴和旋转角度--------------------------
         (setq tmp(distance vect1 '(0 0 0)))
         (setq cosv(/ vectdot tmp))
         (setq tmp2(distance rotatev '(0 0 0)))
         (setq sinv(/ tmp2 tmp))         
         (setq rotatev(mapcar '(lambda(x)(/ x tmp2)) rotatev))
         (setq rotatem(rotatemat rotatev cosv sinv))
         (setq plst(list movetopoint (mapcar '+ startp (mapcar '(lambda(x)(>&> vect1 x)) rotatem))))
         )
       )
     )
        (setq plst (list movetopoint (mapcar '+ startp vect1)));在xy平面上,直接返回移动后的点--
       )
    )
    (t;多于等于三个点以上判断是否共面,如果共面生成旋转矩阵,然后进行坐标点转换--
     (setq vect1(mapcar '- (cadr plst) nth0p)
       vect2(mapcar '- (caddr plst) nth0p)
       norvect(>*> vect1 vect2)
       isplanar t
       tmp(cddr plst)
       moveto(mapcar '- movetopoint nth0p)
       )
     (while (and (setq tmp(cdr tmp)) isplanar)
       (if (equal (>&> (mapcar '- (car tmp) nth0p) norvect) 0 1e-3) nil (setq isplanar nil))
     )
     (if isplanar
       (progn;;所有点在同一个平面---------------------------------
     (if (not (equal (setq rotatev(>*> norvect zdir)) '(0 0 0) 1e-3))
       (progn;;不在xy平面上,生成矩阵--------------------------
         (setq tmp(distance norvect '(0 0 0))
           tmp2(distance rotatev '(0 0 0)))
         (setq cosv(/ (>&> norvect zdir) tmp))
         (setq sinv(/ tmp2 tmp))
         (setq rotatev(mapcar '(lambda(x)(/ x tmp2)) rotatev))
         (setq rotatem(rotatemat rotatev cosv sinv))
         (setq plst(mapcar '(lambda(x)
                   (setq vect1(mapcar '- x nth0p))
                   (mapcar '+ startp (mapcar '(lambda(x)(>&> vect1 x)) rotatem))) plst))
       )
       (setq plst(mapcar '(lambda(x) (mapcar '+ x moveto)) plst));在xy平面也移动到指定位置--
     )
       )
       (setq plst(mapcar '(lambda(x) (mapcar '+ x moveto)) plst));不在一个平面也移动到指定位置--
     )     
    )
  )
  plst
)
(defun >*>(>a >b / a1 a2 a3 b1 b2 b3)
  (setq a1(car >a)
    a2(cadr >a)
    a3(caddr >a)
    b1(car >b)
    b2(cadr >b)
    b3(caddr >b))
  (list (- (* a2 b3)(* a3 b2))
    (- (* a3 b1) (* a1 b3))
    (- (* a1 b2) (* a2 b1)))
)
(defun >&>(>a >b)
 (apply '+ (mapcar '* >a >b))
)
(defun r*mat(r mat)
  (mapcar '(lambda(x)(mapcar '(lambda(y)(* r y)) x))mat)
)
(defun mat+mat(lst1 lst2)
  (mapcar '(lambda(x y)(mapcar '(lambda(m n)(+ m n)) x y)) lst1 lst2)
)
(defun rotatemat(rvec cosv sinv / antimat t1 t2 t3)
  (setq    antimat(list (list 0 (- (caddr rvec)) (cadr rvec))
             (list (caddr rvec) 0 (- (car rvec)))
             (list (- (cadr rvec)) (car rvec) 0))
    t1(list (list cosv 0 0)(list 0 cosv 0)(list 0 0 cosv))
    t2(r*mat (- 1 cosv) (mapcar '(lambda(x)(mapcar '(lambda(y)(* x y)) rvec)) rvec))
    t3(r*mat sinv antimat)
    t1(mat+mat t1 t2)
    t1(mat+mat t1 t3)
    )
)
;;如果位置摆放不合意,自己改变量startp,,很多东西还是得靠自己,本人能力有限.还是不行就只好等待高手来帮你解决了.

linhui12

感谢"xxsheng"兄的回复和无私帮助,谢谢您,程序已经能满足在下册需要了,谢谢

"sailorcwx兄"兄,通过"xxsheng"的以上程序我们就可以得到数据中第一个是管线序号,第二个是M,第三个是R,第四个是N,麻烦您最后结合"绘制双线管程序"将所有的三维多段线都变成"双线管",请sailorcwx兄及各位朋友出出力帮忙完善,因为"绘制双线管程序"是sailorcwx兄写的,请您通过以上求出的M,R,N值,对程序加以调整将所有的多段线以"双线管"形式显示.拜托了.

linhui12

sailorcwx兄,您好.

由于绘图那部分软件原型是您编的,在下不好求助于他人.我知道此程序之前就费了您不少工夫.但现在只差一点了,将数据读取转换模块与您的程序衔接起来.不知是否愿意出手相助,帮忙完善.

在下毕竟也是堂堂七尺男儿,如果您确实没时间或不愿意出手,也请明示!!!倘若您不愿意帮忙我还天天顶帖求您...也怪不好意思的.那我也只好作罢不再强求了.

sailorcwx

网速慢，没留意

sailorcwx

用法

(drawpipers M R N 点坐标串列)

linhui12

sailorcwx兄,您终于出现了.请问我要把您这个"drawpipers"函数添加到以上程序的哪部分里去呢,我是无从下手啊,还望明示.谢谢