明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2279|回复: 4

刚给网友写了个小程序“数据线绘制”,大家看看填充部分能否修改一下加快点速度

[复制链接]
发表于 2003-1-16 21:00:00 | 显示全部楼层 |阅读模式
程序文件及数据文件见压缩包:

因为填充使用了加宽的多段线,速度慢了点,如果用填充速度会更慢。用的是ActiveX方法,如果用普通的command函数更慢。

程序如下:

(defun c:pltxt (/ oldcmd oldblip oldsnap fle fn pt)
  (vl-load-com)
  (setq oldcmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq oldblip (getvar "blipmode"))
  (setvar "blipmode" 0)
  (setq oldsnap (getvar "osmode"))
  (setvar "osmode" 0)
  (setq fle (findfile "txt1.txt"))
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vla-get-ActiveDocument acadObject))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  
  (if (not fle)
    (setq fle (getfiled "请选择数据文件" "txt1" "txt;dat;*" 8))
  )
  (if fle
    (progn
      (initget "1 2 3 4")
      (setq ctype(getkword "\n请选择数据点填充方式[无填充(1)/全填充(2)/半填充(3)/对角填充(4)]<无填充>:"
                           ))
      (if (not ctype)
        (setq ctype "1")
        )
      (setq fn (open fle "r"))
      (read-line fn)
      (setq pt1 (read-line fn))
      (setq pnt1 (read (strcat "(" pt1 ")")))
      (drawcircle pnt1 0.2 CType mSpace)
      
      (while (setq pt2 (read-line fn))
        (setq pnt2 (read (strcat "(" pt2 ")"))
              pnt1 (drawline pnt1 pnt2 0.2 mSpace)
        )
        (drawcircle pnt1 0.2 CType mSpace)
      )
      (close fn)
      (command "zoom" "e")
    )

    (princ "\n未选择数据文件,退出")
  )
  (setvar "cmdecho" oldcmd)
  (setvar "blipmode" oldblip)
  (setvar "osmode" oldsnap)
  (princ)
)
(defun drawline        (pnt1 pnt2 r mSpace / a1 a2 p1 p2)
  (setq        a1 (angle pnt1 pnt2)
        a2 (angle pnt2 pnt1)
        p1 (polar pnt1 a1 r)
        p2 (polar pnt2 a2 r)
  )
  (vla-addLine mSpace (vlax-3d-point p1)(vlax-3d-point p2))
  pnt2
)
(defun ax:2Point (pt1 pt2)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbdouble '(0 . 3))
      (list (car pt1) (cadr pt1)(car pt2) (cadr pt2))
    )
  )
)
(defun drawcircle (pnt r CType mSpace / pt1 pt2 pt3 pt4 pl1 pl2)
  (setq basecircle(vla-addCircle mSpace (vlax-3d-point pnt) r))
  (cond
    (  (= CType "2")
       (setq pt1(polar pnt 0 (/ r 2))
             pt2(polar pnt pi (/ r 2))
        )     
       (setq pl1(vla-AddLightweightPolyline mspace (ax:2Point pt1 pt2))
             pl2(vla-AddLightweightPolyline mspace (ax:2Point pt2 pt1))
             )
       (vla-SetBulge pl1  0 1)
       (vla-SetBulge pl2  0 1)
       (vla-SetWidth pl1  0 r r )
       (vla-SetWidth pl2  0 r r )
     )
    (  (= CType "3")
       (setq pt1(polar pnt 0 (/ r 2))
             pt2(polar pnt pi (/ r 2))
        )     
       (setq pl1(vla-AddLightweightPolyline mspace (ax:2Point pt1 pt2))
             )
       (vla-SetBulge pl1  0 1)
       (vla-SetWidth pl1  0 r r )
     )
    (  (= CType "4")
       (setq pt1(polar pnt 0 (/ r 2))
             pt2(polar pnt (/ pi 2) (/ r 2))
             pt3(polar pnt pi (/ r 2))
             pt4(polar pnt (+ pi (/ pi 2)) (/ r 2))
        )     
       (setq pl1(vla-AddLightweightPolyline mspace (ax:2Point pt1 pt2))
             pl2(vla-AddLightweightPolyline mspace (ax:2Point pt3 pt4))
             )
       (vla-SetBulge pl1  0 0.4142)
       (vla-SetBulge pl2  0 0.4142)
       (vla-SetWidth pl1  0 r r )
       (vla-SetWidth pl2  0 r r )
     )
    )
  )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2003-1-17 09:24:00 | 显示全部楼层

為甚麼填充不用圖塊來做?????

发表于 2003-1-20 11:30:00 | 显示全部楼层

我没有萛图块是否会比较快??(明总帮忙萛萛)程序如内....

(vl-load-com)
(defun C:PLTXT (/          OLDCMD    OLDBLIP   OLDSNAP        FLE
                CTYPE          FN            PT1              PNT1        BNAME
                ACADOBJECT            ACADDOCUMENT        CURSPACE
               )
  (setq OLDCMD (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq OLDBLIP (getvar "blipmode"))
  (setvar "blipmode" 0)
  (setq OLDSNAP (getvar "osmode"))
  (setvar "osmode" 0)
  (setq        ACADOBJECT   (vlax-get-acad-object)
        ACADDOCUMENT (vla-get-activedocument ACADOBJECT)
        CURSPACE     (cond
                       ((= (getvar "TILEMODE") 1)
                        (vla-get-modelspace ACADDOCUMENT)
                       )
                       ((> (getvar "CVPORT") 1)
                        (vla-get-modelspace ACADDOCUMENT)
                       )
                       ((vla-get-paperspace ACADDOCUMENT))
                     )
  )
  (setq FLE (findfile "txt1.txt"))
  (if (not FLE)
    (setq FLE (getfiled "请选择数据文件" "txt1" "txt;dat;*" 8))
  )
  (if FLE
    (progn
      (initget "1 2 3 4")
      (setq CTYPE
             (getkword
               "\n请选择数据点填充方式[无填充(1)/全填充(2)/半填充(3)/对角填充(4)]<无填充>:"
             )
      )
      (if (not CTYPE)
        (setq CTYPE "1")
      )
      (setq FN (open FLE "r"))
      (read-line FN)
      (setq PT1 (read-line FN))
      (setq PNT1 (read (strcat "(" PT1 ")")))
      (cond
        ((= "1" CTYPE)
         (if (not (tblsearch "BLOCK" "无填充"))
           (VMB1)                       
         )
         (setq BNAME "无填充")
        )
        ((= "2" CTYPE)
         (if (not (tblsearch "BLOCK" "全填充"))
           (VMB2)                       
         )
         (setq BNAME "全填充")
        )
        ((= "3" CTYPE)
         (if (not (tblsearch "BLOCK" "半填充"))
           (VMB3)                       
         )
         (setq BNAME "半填充")
        )
        ((= "4" CTYPE)
         (if (not (tblsearch "BLOCK" "对角填充"))
           (VMB4)                       
         )
         (setq BNAME "对角填充")
        )
      )
      (vla-insertblock
        CURSPACE
        (vlax-3d-point PNT1)
        BNAME
        1
        1
        1
        0
      )
      (while (setq PT2 (read-line FN))
        (setq PNT2 (read (strcat "(" PT2 ")"))
              PNT1 (DRAWLINE PNT1 PNT2 0.2 CURSPACE)
        )
        (vla-insertblock
          CURSPACE
          (vlax-3d-point PNT1)
          BNAME
          1
          1
          1
          0
        )
      )
      (close FN)
      (vla-zoomextents ACADOBJECT)
    )
    (princ "\n未选择数据文件,退出")
  )
  (setvar "blipmode" OLDBLIP)
  (setvar "osmode" OLDSNAP)
  (setvar "cmdecho" OLDCMD)
  (vlax-release-object ACADOBJECT)
  (vlax-release-object ACADDOCUMENT)
  (vlax-release-object CURSPACE)
  (princ)
)

(defun DRAWLINE        (PNT1 PNT2 R CURSPACE / A1 A2 P1 P2)
  (setq        A1 (angle PNT1 PNT2)
        A2 (angle PNT2 PNT1)
        P1 (polar PNT1 A1 R)
        P2 (polar PNT2 A2 R)
  )
  (vla-addline CURSPACE (vlax-3d-point P1) (vlax-3d-point P2))
  PNT2
)

(defun AX:2POINT (PT1 PT2)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbdouble '(0 . 3))
      (list (car PT1) (cadr PT1) (car PT2) (cadr PT2))
    )
  )
)

(defun VMB1 (/ CURDOC BLKREF)
  (setq CURDOC (vla-get-activedocument (vlax-get-acad-object)))
  (setq        BLKREF (vla-add        (vla-get-blocks CURDOC)
                        (vlax-3d-point '(0 0 0))
                        "无填充"
               )
  )
  (vla-addcircle BLKREF (vlax-3d-point '(0 0 0)) 0.2)
  (vlax-release-object CURDOC)
  (vlax-release-object BLKREF)
  (princ)
)

(defun VMB2 (/ CURDOC BLKREF PT1 PT2 PL1 PL2 R)
  (setq CURDOC (vla-get-activedocument (vlax-get-acad-object)))
  (setq        BLKREF (vla-add        (vla-get-blocks CURDOC)
                        (vlax-3d-point '(0 0 0))
                        "全填充"
               )
  )
  (vla-addcircle BLKREF (vlax-3d-point '(0 0 0)) 0.2)
  (setq R 0.2)
  (setq        PT1 (polar '(0 0 0) 0 (/ R 2))
        PT2 (polar '(0 0 0) pi (/ R 2))
  )
  (setq        PL1 (vla-addlightweightpolyline BLKREF (AX:2POINT PT1 PT2))
        PL2 (vla-addlightweightpolyline BLKREF (AX:2POINT PT2 PT1))
  )
  (vla-setbulge PL1 0 1)
  (vla-setbulge PL2 0 1)
  (vla-setwidth PL1 0 R R)
  (vla-setwidth PL2 0 R R)
  (vlax-release-object CURDOC)
  (vlax-release-object BLKREF)
  (princ)
)
(defun VMB3 (/ CURDOC BLKREF PT1 PT2 PL1 R)
  (setq CURDOC (vla-get-activedocument (vlax-get-acad-object)))
  (setq        BLKREF (vla-add        (vla-get-blocks CURDOC)
                        (vlax-3d-point '(0 0 0))
                        "半填充"
               )
  )
  (vla-addcircle BLKREF (vlax-3d-point '(0 0 0)) 0.2)
  (setq R 0.2)
  (setq        PT1 (polar '(0 0 0) 0 (/ R 2))
        PT2 (polar '(0 0 0) pi (/ R 2))
  )
  (setq        PL1 (vla-addlightweightpolyline BLKREF (AX:2POINT PT1 PT2))
  )
  (vla-setbulge PL1 0 1)
  (vla-setwidth PL1 0 R R)
  (vlax-release-object CURDOC)
  (vlax-release-object BLKREF)
  (princ)
)

(defun VMB4 (/ CURDOC BLKREF PT1 PT2 PL1 PL2 R)
  (setq CURDOC (vla-get-activedocument (vlax-get-acad-object)))
  (setq        BLKREF (vla-add        (vla-get-blocks CURDOC)
                        (vlax-3d-point '(0 0 0))
                        "对角填充"
               )
  )
  (vla-addcircle BLKREF (vlax-3d-point '(0 0 0)) 0.2)
  (setq R 0.2)
  (setq        PT1 (polar '(0 0 0) 0 (/ R 2))
        PT2 (polar '(0 0 0) (/ pi 2) (/ R 2))
        PT3 (polar '(0 0 0) pi (/ R 2))
        PT4 (polar '(0 0 0) (+ pi (/ pi 2)) (/ R 2))
  )
  (setq        PL1 (vla-addlightweightpolyline BLKREF (AX:2POINT PT1 PT2))
        PL2 (vla-addlightweightpolyline BLKREF (AX:2POINT PT3 PT4))
  )
  (vla-setbulge PL1 0 0.4142)
  (vla-setbulge PL2 0 0.4142)
  (vla-setwidth PL1 0 R R)
  (vla-setwidth PL2 0 R R)
  (vlax-release-object CURDOC)
  (vlax-release-object BLKREF)
  (princ)
)
 楼主| 发表于 2003-1-20 12:21:00 | 显示全部楼层

我也写了一个,用的是匿名块的方式,填充时速度比原先快了三分之一左右

(defun c:pltxt (/ oldcmd oldblip oldsnap fle fn pt)
  (vl-load-com)
  (setq oldcmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq oldblip (getvar "blipmode"))
  (setvar "blipmode" 0)
  (setq oldsnap (getvar "osmode"))
  (setvar "osmode" 0)
  (setq fle (findfile "txt1.txt"))
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vla-get-ActiveDocument acadObject))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  (setq blocks (vla-get-blocks acadDocument))

  (if (not fle)
    (setq fle (getfiled "请选择数据文件" "txt1" "txt;dat;*" 8))
  )
  (if fle
    (progn
      (initget "1 2 3 4")
      (setq ctype
             (getkword
               "\n请选择数据点填充方式[无填充(1)/全填充(2)/半填充(3)/对角填充(4)]<无填充>:"
             )
      )
      (setq stime(getvar"date"))
      (if (not ctype)
        (setq ctype "1")
      )
      (setq fn (open fle "r"))
      (read-line fn)
      (setq pt1 (read-line fn))
      (setq pnt1 (read (strcat "(" pt1 ")")))
      (setq blkname (makeblk 0.2 ctype blocks))
      (vla-insertblock
        mspace
        (vlax-3d-point pnt1)
        blkname
        1
        1
        1
        0
      )
      (setq pnt0 pnt1)
      (while (setq pt2 (read-line fn))
        (setq pnt2 (read (strcat "(" pt2 ")"))
              pnt1 (drawline pnt1 pnt2 0.2 mSpace)
        )
        (vla-insertblock mspace (vlax-3d-point pnt1) blkname 1 1 1 0)
      )
      (close fn)
      (grtext)
      (setq etime(getvar"date"))
      (princ "\n程序共耗用时间:")
      (princ (* 86400.0 (- (- etime stime) (fix (- etime stime)))))
      (princ "秒")
      (command "zoom" "e")
    )

    (princ "\n未选择数据文件,退出")
  )
  (setvar "cmdecho" oldcmd)
  (setvar "blipmode" oldblip)
  (setvar "osmode" oldsnap)
  (princ)
)

(defun drawline        (pnt1 pnt2 r mSpace / a1 a2 p1 p2)
  (setq        a1 (angle pnt1 pnt2)
        a2 (angle pnt2 pnt1)
        p1 (polar pnt1 a1 r)
        p2 (polar pnt2 a2 r)
  )
  (vla-addLine mSpace (vlax-3d-point p1) (vlax-3d-point p2))
  pnt2
)

(defun ax:2Point (pt1 pt2)
  (vlax-make-variant
    (vlax-safearray-fill
      (vlax-make-safearray vlax-vbdouble '(0 . 3))
      (list (car pt1) (cadr pt1) (car pt2) (cadr pt2))
    )
  )
)

(defun makeblk (r CType blocks / pt1 pt2 pt3 pt4 pl1 pl2 inspnt blkobj basecircle blkname)
  (setq        inspnt (vlax-make-variant
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbdouble '(0 . 2))
                   '(0 0 0)
                 )
               )
  )

  (setq blkobj (vla-add blocks inspnt "*U"))


  (setq basecircle (vla-addCircle blkobj inspnt r))
  (cond
    ((= CType "2")
     (setq pt1 (polar '(0 0) 0 (/ r 2))
           pt2 (polar '(0 0) pi (/ r 2))
     )
     (setq pl1 (vla-AddLightweightPolyline blkobj (ax:2Point pt1 pt2))
           pl2 (vla-AddLightweightPolyline blkobj (ax:2Point pt2 pt1))
     )
     (vla-SetBulge pl1 0 1)
     (vla-SetBulge pl2 0 1)
     (vla-SetWidth pl1 0 r r)
     (vla-SetWidth pl2 0 r r)
    )
    ((= CType "3")
     (setq pt1 (polar '(0 0) 0 (/ r 2))
           pt2 (polar '(0 0) pi (/ r 2))
     )
     (setq pl1 (vla-AddLightweightPolyline blkobj (ax:2Point pt1 pt2))
     )
     (vla-SetBulge pl1 0 1)
     (vla-SetWidth pl1 0 r r)
    )
    ((= CType "4")
     (setq pt1 (polar '(0 0) 0 (/ r 2))
           pt2 (polar '(0 0) (/ pi 2) (/ r 2))
           pt3 (polar '(0 0) pi (/ r 2))
           pt4 (polar '(0 0) (+ pi (/ pi 2)) (/ r 2))
     )
     (setq pl1 (vla-AddLightweightPolyline blkobj (ax:2Point pt1 pt2))
           pl2 (vla-AddLightweightPolyline blkobj (ax:2Point pt3 pt4))
     )
     (vla-SetBulge pl1 0 0.4142)
     (vla-SetBulge pl2 0 0.4142)
     (vla-SetWidth pl1 0 r r)
     (vla-SetWidth pl2 0 r r)
    )
  )
  (setq blkname (vla-get-name blkobj))
)
 楼主| 发表于 2003-1-20 12:24:00 | 显示全部楼层

速度比较的数据,哦---速度是快了一倍多,但无填充速度倒慢了

经过比较,三个程序的时间如下(按你给的数据):
             新版本            旧版本  
无填充        1.14              0.76           
全填充        0.93              2.03           
对角填充      0.92              2.36
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-2-22 02:40 , Processed in 0.194991 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表