[求助]：如何把下面用l的函数用ActiveX的方法实现

以诺 · 发表于 2005-12-9 11:14:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

因为我在工程中加了一个反应器,在反应器中回调这个函数,
但这个函数中调用了AutoCAD命令,反应器中不支持,
所以我想把下面函数实现的功能用ActiveX方法来实现,
由于不太熟练,时间又不多,就想到了这里,
请大家帮帮我,有对ActiveX较熟的,有时间帮我翻译一下,
谢谢!!
;******************************************************************
;*函数名:  fkqd_showtext ()                                     ;*
;*功能:  显示圈定范围内的储量以及其它信息 ;*
;*说明:  ptInsert：插入基点(圆心)                      ;*
;*          all_dzksl :地质矿石量 all_scksl  :生产矿石量 ;*
;*          dzfepw    ;地质Fe品位 scfepw    :生产Fe品位  ;*
;*          dzspw       ;地质s品位    scspw    :生产s品位 ;*
;*          dzppw       ;地质p品位    scppw    :生产p品位 ;*
;*完成时间:  2005.06.10                                              ;*
;******************************************************************
(defun fkqd_showtext(ptInsert  all_dzksl dzfepw dzspw dzppw
      all_scksl scfepw scspw scppw
            / radius x y y_dis textHigh jsl pw
                  group_num len y_dis pt1y Distan dy
                  step gc_block_name block_name ss ss_fkqd)
  (setq all_dzksl (rtos all_dzksl))
  (setq dzfepw (rtos dzfepw ))
  (setq dzspw    (rtos dzspw ))
  (setq dzppw    (rtos dzppw ))
  (setq all_scksl (rtos all_scksl))
  (setq scfepw (rtos scfepw ))
  (setq scspw    (rtos scspw ))
  (setq scppw    (rtos scppw ))
  (setq x (nth 0 ptInsert)
y (nth 1 ptInsert))
  (setq radius  20 )
  (command "color" "white")
  ;以下用于绘制范围储量数据输入的圆圈绘制以及框框划分
  (setq ss_fkqd (ssadd))
  (command "circle" ptInsert radius )
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "line" (list (+ x 20) y) (list (- x 20) y) "")
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "line" (list (+ x 12)(- y 16)) (list (+ x 12)(+ y 16)) "")
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "line" (list (+ x 4 )(- y 19)) (list (+ x 4) (+ y 19)) "")
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "line" (list (- x 4 )(- y 19)) (list (- x 4) (+ y 19)) "")
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "line" (list (- x 12)(- y 16)) (list (- x 12)(+ y 16)) "")
  (setq  ss (entlast))
  (ssadd ss ss_fkqd )
  (command "style" "shl" "宋体" 3 "1" "" "y" "")
  (command "text" (list (+ x 14) (- y 10))  "270"  "地质")
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (+ x 14) (+ y  2))  "270"  "生产")
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "style" "shl" "宋体" 2.5 "1" "" "y" "")
  (command "text" (list (+ x 6.5) (- y 16))  "270"  all_dzksl)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (+ x 6.5) (+ y  2))  "270"  all_scksl)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 1.5) (- y 16))  "270"  dzfepw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 1.5) (+ y  2))  "270"  scfepw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 9.5) (- y 16))  "270"  dzspw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 9.5) (+ y  2))  "270"  scspw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 17.5) (- y 16))  "270"  dzppw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (command "text" (list (- x 17.5) (+ y  2))  "270"  scppw)
  (setq ss (entlast))
  (ssadd ss ss_fkqd)
  (if (= Str_InputNumber nil)
   (setq Str_InputNumber "R")
  )
  (if (= fkclqd_block_flag nil)
   (setq fkclqd_block_flag 0)
   (setq fkclqd_block_flag (+ fkclqd_block_flag 1))
  );end if(= zk_block_flag nil)
  (setq gc_block_name (itoa fkclqd_block_flag))
  (setq block_name (strcat "fkqd_" gc_block_name Str_InputNumber))
  (command "block" block_name ptInsert ss_fkqd "")
  (command "insert" block_name  ptInsert 1.0 1.0 "" )
)

eachy · 发表于 2005-12-9 13:05:42

未经测试

;|
******************************************************************
*函数名: fkqd_showtext () ;*
*功能: 显示圈定范围内的储量以及其它信息 ;*
*说明: ptInsert：插入基点(圆心) ;*
* all_dzksl :地质矿石量 all_scksl :生产矿石量 ;*
* dzfepw ;地质Fe品位 scfepw :生产Fe品位 ;*
* dzspw ;地质s品位 scspw :生产s品位 ;*
* dzppw ;地质p品位 scppw :生产p品位 ;*
*完成时间: 2005.06.10 ;*
******************************************************************
|;
(defun fkqd_showtext (ptinsert all_dzksl dzfepw
dzspw dzppw all_scksl
scfepw scspw scppw
/ blkdef block_name
fkclqd_block_flag gc_block_name
modelspace radius str_inputnumber
sty thisdrawing xdl-addline
xdl-addtext
)
(defun xdl-addline (obj p1 p2)
(vla-addline
obj
(vlax-3d-point p1)
(vlax-3d-point p2)
)
)
(defun xdl-addtext (obj str p / txt)
(setq txt (vla-addtext obj str (vlax-3d-point p)))
(vla-put-rotation txt (* 1.5 pi))
)
(if (= Str_InputNumber nil)
(setq Str_InputNumber "R")
)
(if (= fkclqd_block_flag nil)
(setq fkclqd_block_flag 0)
(setq fkclqd_block_flag (+ fkclqd_block_flag 1))
) ;_end if(= zk_block_flag nil)
(setq gc_block_name (itoa fkclqd_block_flag))
(setq all_dzksl (rtos all_dzksl)
dzfepw (rtos dzfepw)
dzspw (rtos dzspw)
dzppw (rtos dzppw)
all_scksl (rtos all_scksl)
scfepw (rtos scfepw)
scspw (rtos scspw)
scppw (rtos scppw)
x (car ptInsert)
y (cadr ptInsert)
radius 20
thisdrawing (vla-get-activedocument (vlax-get-acad-object))
modelspace (vla-get-modelspace thisdrawing)
)
(vla-setvariable thisdrawing "color" "white")
(setq blkdef (vla-add (vla-get-blocks thisdrawing)
(vlax-3d-point '(0. 0. 0.))
(strcat "fkqd_" gc_block_name Str_InputNumber)
)
)
;;(command "color" "white")
;;以下用于绘制范围储量数据输入的圆圈绘制以及框框划分
;;(command "circle" ptInsert radius)
(vla-addcircle blkdef (vlax-3d-point '(0. 0. 0.)) radius)
(mapcar '(lambda (x)
(xdl-addline blkdef (car x) (cadr x))
)
'(((20 0) (-20 0))
((12 -16) (12 16))
((4 -19) (4 19))
((-4 -19) (-4 19))
((-12 -16) (-12 16))
)
)
;|
(command "line" (list (+ x 20) y) (list (- x 20) y) "")
(command "line"
(list (+ x 12) (- y 16))
(list (+ x 12) (+ y 16))
""
)
(command "line"
(list (+ x 4) (- y 19))
(list (+ x 4) (+ y 19))
""
)
(command "line"
(list (- x 4) (- y 19))
(list (- x 4) (+ y 19))
""
)
(command "line"
(list (- x 12) (- y 16))
(list (- x 12) (+ y 16))
""
)
|;
(if (not (tblsearch "textstyle" "shl"))
(progn
(setq sty (vla-add (vla-get-textstyle thisdrawing) "shl"))
(vla-put-fontfile sty "宋体")
(vla-setvariable thisdrawing "teststyle" "shl")
(vla-put-height sty 3.)
(vla-put-TextGenerationFlag sty acTextFlagBackward)
)
(vla-setvariable thisdrawing "teststyle" "shl")
)
(mapcar '(lambda (a b)
(xdl-addtext blkdef a b)
)
(list "地质" "生产" all_dzksl all_scksl dzfepw
scfepw dzspw scspw dzppw scppw
)
'((14 -10)
(14 2)
(6.5 -16)
(6.5 2)
(-1.5 -16)
(-1.5 2)
(-9.5 -16)
(-9.5 2)
(-17.5 -16)
(-17.5 2)
)
)
(vla-insertblock
modelspace
(vlax-3d-point ptinsert)
block_name
1.
1.
1.
0.
)
;|
(command "style" "shl" "宋体" 3 "1" "" "y" "")
(command "text" (list (+ x 14) (- y 10)) "270" "地质")
(command "text" (list (+ x 14) (+ y 2)) "270" "生产")
(command "style" "shl" "宋体" 2.5 "1" "" "y" "")
(command "text" (list (+ x 6.5) (- y 16)) "270" all_dzksl)
(command "text" (list (+ x 6.5) (+ y 2)) "270" all_scksl)
(command "text" (list (- x 1.5) (- y 16)) "270" dzfepw)
(command "text" (list (- x 1.5) (+ y 2)) "270" scfepw)
(command "text" (list (- x 9.5) (- y 16)) "270" dzspw)
(command "text" (list (- x 9.5) (+ y 2)) "270" scspw)
(command "text" (list (- x 17.5) (- y 16)) "270" dzppw)
(command "text" (list (- x 17.5) (+ y 2)) "270" scppw)
(command "block" block_name ptInsert ss_fkqd "")
(command "insert" block_name ptInsert 1.0 1.0 "")
|;
)

;| 
****************************************************************** 
*函 数 名: fkqd_showtext () ;* 
*功 能: 显示圈定范围内的储量以及其它信息 ;* 
*说 明: ptInsert：插入基点(圆心) ;* 
* all_dzksl :地质矿石量 all_scksl :生产矿石量 ;* 
* dzfepw ;地质Fe品位 scfepw :生产Fe品位 ;* 
* dzspw ;地质s品位 scspw :生产s品位 ;* 
* dzppw ;地质p品位 scppw :生产p品位 ;* 
*完成时间: 2005.06.10 ;* 
****************************************************************** 
|; 
(defun fkqd_showtext (ptinsert            all_dzksl          dzfepw 
                      dzspw            dzppw          all_scksl 
                      scfepw            scspw          scppw 
                      /                    blkdef          block_name 
                      fkclqd_block_flag                  gc_block_name 
                      modelspace    radius          str_inputnumber 
                      sty            thisdrawing          xdl-addline 
                      xdl-addtext 
                     ) 
  (defun xdl-addline (obj p1 p2) 
    (vla-addline 
      obj 
      (vlax-3d-point p1) 
      (vlax-3d-point p2) 
    ) 
  ) 
  (defun xdl-addtext (obj str p / txt) 
    (setq txt (vla-addtext obj str (vlax-3d-point p))) 
    (vla-put-rotation txt (* 1.5 pi)) 
  ) 
  (if (= Str_InputNumber nil) 
    (setq Str_InputNumber "R") 
  ) 
  (if (= fkclqd_block_flag nil) 
    (setq fkclqd_block_flag 0) 
    (setq fkclqd_block_flag (+ fkclqd_block_flag 1)) 
  ) ;_end if(= zk_block_flag nil) 
  (setq gc_block_name (itoa fkclqd_block_flag)) 
  (setq        all_dzksl   (rtos all_dzksl) 
        dzfepw            (rtos dzfepw) 
        dzspw            (rtos dzspw) 
        dzppw            (rtos dzppw) 
        all_scksl   (rtos all_scksl) 
        scfepw            (rtos scfepw) 
        scspw            (rtos scspw) 
        scppw            (rtos scppw) 
        x            (car ptInsert) 
        y            (cadr ptInsert) 
        radius            20 
        thisdrawing (vla-get-activedocument (vlax-get-acad-object)) 
        modelspace  (vla-get-modelspace thisdrawing) 
  ) 
  (vla-setvariable thisdrawing "color" "white") 
  (setq        blkdef (vla-add        (vla-get-blocks thisdrawing) 
                        (vlax-3d-point '(0. 0. 0.)) 
                        (strcat "fkqd_" gc_block_name Str_InputNumber) 
               ) 
  ) 
  ;;(command "color" "white") 
  ;;以下用于绘制范围储量数据输入的圆圈绘制以及框框划分 
  ;;(command "circle" ptInsert radius)   
  (vla-addcircle blkdef (vlax-3d-point '(0. 0. 0.)) radius) 
  (mapcar '(lambda (x) 
             (xdl-addline blkdef (car x) (cadr x)) 
           ) 
          '(((20 0) (-20 0)) 
            ((12 -16) (12 16)) 
            ((4 -19) (4 19)) 
            ((-4 -19) (-4 19)) 
            ((-12 -16) (-12 16)) 
           ) 
  ) 
  ;| 
  (command "line" (list (+ x 20) y) (list (- x 20) y) "") 
  (command "line" 
             (list (+ x 12) (- y 16)) 
             (list (+ x 12) (+ y 16)) 
             "" 
  ) 
   (command "line" 
           (list (+ x 4) (- y 19)) 
           (list (+ x 4) (+ y 19)) 
           "" 
  ) 
  (command "line" 
           (list (- x 4) (- y 19)) 
           (list (- x 4) (+ y 19)) 
           "" 
  ) 
  (command "line" 
           (list (- x 12) (- y 16)) 
           (list (- x 12) (+ y 16)) 
           "" 
  ) 
  |; 
  (if (not (tblsearch "textstyle" "shl")) 
    (progn 
      (setq sty (vla-add (vla-get-textstyle thisdrawing) "shl")) 
      (vla-put-fontfile sty "宋体") 
      (vla-setvariable thisdrawing "teststyle" "shl") 
      (vla-put-height sty 3.) 
      (vla-put-TextGenerationFlag sty acTextFlagBackward) 
    ) 
    (vla-setvariable thisdrawing "teststyle" "shl") 
  ) 
  (mapcar '(lambda (a b) 
             (xdl-addtext blkdef a b) 
           ) 
          (list        "地质"          "生产"    all_dzksl all_scksl        dzfepw 
                scfepw          dzspw            scspw     dzppw        scppw 
               ) 
          '((14 -10) 
            (14 2) 
            (6.5 -16) 
            (6.5 2) 
            (-1.5 -16) 
            (-1.5 2) 
            (-9.5 -16) 
            (-9.5 2) 
            (-17.5 -16) 
            (-17.5 2) 
           ) 
  ) 
  (vla-insertblock 
    modelspace 
    (vlax-3d-point ptinsert) 
    block_name 
    1. 
    1. 
    1. 
    0. 
  ) 
  ;| 
  (command "style" "shl" "宋体" 3 "1" "" "y" "") 
  (command "text" (list (+ x 14) (- y 10)) "270" "地质") 
  (command "text" (list (+ x 14) (+ y 2)) "270" "生产") 
  (command "style" "shl" "宋体" 2.5 "1" "" "y" "") 
  (command "text" (list (+ x 6.5) (- y 16)) "270" all_dzksl) 
  (command "text" (list (+ x 6.5) (+ y 2)) "270" all_scksl) 
  (command "text" (list (- x 1.5) (- y 16)) "270" dzfepw) 
  (command "text" (list (- x 1.5) (+ y 2)) "270" scfepw) 
  (command "text" (list (- x 9.5) (- y 16)) "270" dzspw) 
  (command "text" (list (- x 9.5) (+ y 2)) "270" scspw) 
  (command "text" (list (- x 17.5) (- y 16)) "270" dzppw) 
  (command "text" (list (- x 17.5) (+ y 2)) "270" scppw) 
  (command "block" block_name ptInsert ss_fkqd "") 
  (command "insert" block_name ptInsert 1.0 1.0 "") 
  |; 
)

xyp1964 · 发表于 2005-12-9 14:54:07

反应器就像“反应堆“，威力无穷！

eachy · 发表于 2005-12-9 18:51:24

程序中的作块部分应该只有一次,如果图中已存在该图块则直接 InsertBlock

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：如何把下面用l的函数用ActiveX的方法实现

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子