[LISP]

waterhot

求救！


高手快来看那！

waterhot

1. [QUOTE][CODE] 帮助修改一下，使得可可以运行！  

复制代码

;;使用ActiveX创建多段线(二维)
;(vl-load-com)
;(setq *ModelSpace* (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object))));;初始化空间
;;
(defun c:dd ()
   
     (setq HOLDECHO (getvar "cmdecho"))
     (setvar "cmdecho" 0)
   
     (setq n_s 10);;一行中有多少个点（根据实际情况确定）
     (setq w_e 2);;一列中有多少个点（根据实际情况确定）   ;;画河道横向线（垂直水流方向）
     (print "\nTo draw the y_oriented line")
     (princ)
   (textpage)
     (setq ss (getfiled "Open file" "d:\\" "dat" 8)
     s   t
     fn nil)
         (setq i 1)
         (setq k 1)
     (if ss
         (progn
             (setq fn (open ss "r"))
             (print "\n Please waiting....")
             (princ)
             (while (<= i w_e)
                         (while (<= k n_s)
                                 (setq s (read-line fn))
                   (print s)
                   (princ)
                                 (setq ps (cons (list (car(read s)) (car (cdr (read s)))) ps))
                   (print ps)
                   (princ)
                   (setq k (1+ k))
                         )
                         (setq ps (reverse ps))
                         (draw_pline ps)
                         (setq i (1+ i))
               )
               (close fn)
         )
         (print "\n the file error! ")
       )
   ;画河道纵向线（顺水流方向）
;       (setq j 1)
;       (print "\nTo draw the x_oriented line")
;       (setq ss (getfiled "Open file" "d:\\" "dat" 8)
;       s   t
;       fn nil)
;     (if ss
;         (progn
;             (setq fn (open ss "r"))
;             (print "\n Please waiting....")
;             (while (<= j w_e)
;                         (while s
;                               (setq s (read-line fn))
;                               (setq pps (cons (read s) pps))
;                         )
;                         (setq pps (reverse pps))
;                         (draw_pline pps)
;                         (setq j (1+ j))
;                         (setq s t)
;               )
;               (close fn)
;         )
;         (print "\n the file error! ")
;     )
;   ;
   (setvar "cmdecho" HOLDECHO)
   (princ)
  )
;;
(defun draw_pline (pointlist);;输入参数点表，形如：((x1 y1) (x2 y2) (x3 y3)...)
           (setq polypoints (apply 'append   pointlist)
           (setq VLADataPts (list->variantArray polypoints))
  ;;定义ActiveX方法生成多段线
           (setq pline (vla-addLightweightPolyline
           (vla-get-ModelSpace
               (vla-get-ActiveDocument
      (vlax-get-Acad-Object)
               )
             )
                                       VLADataPts)
           )
           (vla-put-closed pline vlax-false)
;-------------------------------------
);给以双精度表示的二维点数组分配空间 (x1 y1 x2 y2 x3 y3...)->(x1 y1 x2 y3 x3 y3...)
  (defun list->variantArray (ptsList / arraySpace sArray);;
         (setq arraySpace (vlax-make-safearray
                                                     vlax-vbdouble ;元素类别
                                                   (cons 0
                                                   (- (length ptsList) 1); 数组维数
                                                   )
                                             )
           )
         (setq sArray (vlax-safearray-fill arraySpace ptsList))
         (vlax-make-variant sArray); 返回数组变体
)
[/CODE]

waterhot

怎么没人哪！


快来呀！

meflying

你不给一个dat文件，别人怎么知道能不能运行？


不过这里丢了一个括号，你加上后，看看能不能运行先。。。


(setq polypoints (apply 'append         pointlist)


-&gt; (setq polypoints (apply 'append         pointlist))

waterhot

谢谢回复，我不知道怎么上转数据文件?

meflying

不是急吗？那为什么不去试试我后面说的，如果可以了，还传什么数据啊

waterhot

真是一个)的问题：

waterhot

但是在屏幕上没有画出多段线来呀？


为什么呢？

waterhot

数据如下：(9442.00000000000 13523.0000000000)
(9602.44083730788 13518.2053431552)
(9773.21560137878 13517.7870245506)
(9930.95221281122 13514.9813567183)
(10121.9983028150 13511.1385546831)
(10310.3496636903 13547.5327119832)
(10467.3268423648 13584.4245220356)
(10644.8039968324 13623.8745115228)
(10789.2344696039 13683.3010218549)
(1004.7204471789 13748.4852401943) meflying可否调试一下？盼望回复！！！！

meflying

这句改一下：


(vla-put-closed pline vlax-false)


-&gt;(vla-put-closed pline :vlax-false)


如果看不见结果，可能图形不在屏幕中央，使用命令：ZOOM，E选项查看