能在cad窗口中实现象数字相关表格么?

ljcgq · 发表于 2004-2-4 18:32:00

能在cad窗口中实现象EXCEL一样的数字相关表格么?

如上图中 E=A+B+C+D 如果修改A ,B或 C,D 中任意一个侧E 也会发生相应的变化,

tukuitk · 发表于 2004-2-5 12:43:00

能！要用到反应器的知识了。

ljcgq · 发表于 2004-2-5 19:13:00

能帮忙写一段让我学学么?

cnks · 发表于 2004-2-8 13:29:00

是呀，能让我们学学嘛？现在图纸特别多，能这样可以节省很多时间呀

meflying · 发表于 2004-2-8 14:20:00

说具体点，不要用如什么什么的，因为这些关系一旦写好了，要改就可能比较麻烦。

ljcgq · 发表于 2004-2-8 21:24:00

表格第一列a是序号，第二列b是规格，第三列c是长度，第四列d是数量，第五列e是单重，第六列f总重.

主要是根据第二列的规格来确定其计算方法，即每行有可能会不同的计算方法

先做一个算型钢的，

b相对应得每米重 * c = e e * d = f

meflying · 发表于 2004-2-9 16:16:00

结果数字就是等号后面的，数据就是等号前面的加载后命令：ass

(vl-load-com)
(defun UnFormat (Mtext KeepLF / Text Str)
(cond
((= (type Mtext) 'VLA-Object))
((= (type Mtext) 'ENAME)
(setq Mtext (vlax-ename->vla-object Mtext))
)
(1 (setq Mtext nil))
)
(and
Mtext
(= (vlax-get Mtext 'ObjectName) "AcDbMText")
(setq Mtext (vlax-get Mtext 'TextString))
(setq Text "")
(while (/= Mtext "")
(cond
((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}`~]")
(setq Mtext (substr Mtext 3)
Text (strcat Text Str)
)
)
((wcmatch (substr Mtext 1 1) "[{}]")
(setq Mtext (substr Mtext 2))
)
((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P"))
(setq Mtext (substr Mtext 3)
Text (strcat Text "\\P")
)
)
((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]")
(setq Mtext (substr Mtext 3))
)
((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
(setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
)
((wcmatch (strcase (substr Mtext 1 2)) "\\S")
(setq Str (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
Text (strcat Text (vl-string-translate "#^\" " " Str))
Mtext (substr Mtext (+ 4 (strlen Str)))
)
(print Str)
)
(1
(setq Text (strcat Text (substr Mtext 1 1))
Mtext (substr Mtext 2)
)
)
)
)
)
Text
)(defun GetTxt(ent / ents)
(setq ents (entget ent))
(if (= (cdr (assoc 0 ents)) "TEXT")
(cdr (assoc 1 ents))
(Unformat ent nil)
)
)(defun MakeEx(ent Handle / ss ename vname datatype data n)
(setq n nil)
(setq vname (vlax-ename->vla-object ent))
(setq datatype (vlax-make-safearray vlax-vbInteger (cons 0 (length handle))))
(vlax-safearray-fill datatype (append '(1001) (repeat (length handle) (setq n (append n (list 1000))))))
(setq data (vlax-make-safearray vlax-vbvariant (cons 0 (length handle))))
(vlax-safearray-fill data (append '("ForCal_meflying") Handle))
(vla-setxdata vname datatype data)
)(defun GetEx(obj appname / xtypeOut xdataOut)
(vla-getxdata obj "" 'xtypeOut 'xdataOut)
(cdr (mapcar 'vlax-variant-value (vlax-safearray->list xdataOut)))
)(defun Cal (notifier-object reactor-object parameter-list / handles i ent txt Datas Result ents)
(setq Datas nil)
(setq handles (GetEx notifier-object "ForCal_meflying"))
(setq i 1)
(repeat (1- (length handles))
(setq ent (handent (nth i handles)))
(setq txt (GetTxt ent))
(setq Datas (append Datas (list (atof txt))))
(setq i (1+ i))
)
(setq ent (handent (car handles)))
(setq Result (apply '* Datas))
(setq ents (entget ent))
(setq ents (subst (cons 1 (rtos Result)) (assoc 1 ents) ents))
(entmod ents)
(princ)
)
(defun MakeReactor (ent)
(setq circleReactor (vlr-object-reactor (list (vlax-ename->vla-object ent))
"Reactor" '((:vlr-modified . Cal))))
)(defun c:Ass( / handles entresult ss handResult ent i)
(setq handles nil)
(setq entResult (car (entsel "选择结果数字...")))
(prompt "选择数据文字...")
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq handResult (cdr (assoc 5 (entget entResult))))
(setq i 0)
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq handles (append handles (list (cdr (assoc 5 (entget ent))))))
(setq i (1+ i))
)
(setq i 0)
(repeat (length handles)
(setq ent (ssname ss i))
(MakeEx ent (cons handResult handles))
(MakeReactor ent)
(setq i (1+ i))
)
(princ)
)

(vl-load-com)
(defun UnFormat (Mtext KeepLF / Text Str) 
   (cond 
       ((= (type Mtext) 'VLA-Object)) 
       ((= (type Mtext) 'ENAME) 
           (setq Mtext (vlax-ename->vla-object Mtext)) 
       ) 
       (1 (setq Mtext nil)) 
   ) 
   (and 
       Mtext 
       (= (vlax-get Mtext 'ObjectName) "AcDbMText") 
       (setq Mtext (vlax-get Mtext 'TextString)) 
       (setq Text "") 
       (while (/= Mtext "") 
           (cond 
               ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}`~]") 
                   (setq Mtext (substr Mtext 3) 
                               Text     (strcat Text Str) 
                   ) 
               ) 
               ((wcmatch (substr Mtext 1 1) "[{}]") 
                   (setq Mtext (substr Mtext 2)) 
               ) 
               ((and KeepLF (wcmatch (strcase (substr Mtext 1 2)) "\\P")) 
                   (setq Mtext (substr Mtext 3) 
                               Text   (strcat Text "\\P") 
                   ) 
               ) 
               ((wcmatch (strcase (substr Mtext 1 2)) "\\[LOP]") 
                   (setq Mtext (substr Mtext 3)) 
               ) 
               ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]") 
                   (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))) 
               ) 
               ((wcmatch (strcase (substr Mtext 1 2)) "\\S") 
                   (setq Str     (substr Mtext 3 (- (vl-string-search ";" Mtext) 2)) 
                               Text   (strcat Text (vl-string-translate "#^\" "     " Str)) 
                               Mtext (substr Mtext (+ 4 (strlen Str))) 
                   ) 
                   (print Str) 
               ) 
               (1 
                   (setq Text (strcat Text (substr Mtext 1 1)) 
                               Mtext (substr Mtext 2) 
                   ) 
               ) 
           ) 
       ) 
   ) 
   Text 
)(defun GetTxt(ent / ents)
   (setq ents (entget ent))
   (if (= (cdr (assoc 0 ents)) "TEXT")
       (cdr (assoc 1 ents))
       (Unformat ent nil)
   )
)(defun MakeEx(ent Handle / ss ename vname datatype data n)
   (setq n nil)
   (setq vname (vlax-ename->vla-object ent))
   (setq datatype (vlax-make-safearray vlax-vbInteger (cons 0 (length handle))))
   (vlax-safearray-fill datatype (append '(1001) (repeat (length handle) (setq n (append n (list 1000))))))
   (setq data (vlax-make-safearray vlax-vbvariant (cons 0 (length handle))))
   (vlax-safearray-fill data (append '("ForCal_meflying") Handle))
   (vla-setxdata vname datatype data)
)(defun GetEx(obj appname / xtypeOut xdataOut)
   (vla-getxdata obj "" 'xtypeOut 'xdataOut)
   (cdr (mapcar 'vlax-variant-value (vlax-safearray->list xdataOut)))
)(defun Cal (notifier-object reactor-object parameter-list / handles i ent txt Datas Result ents)
   (setq Datas nil)
   (setq handles (GetEx notifier-object "ForCal_meflying"))
   (setq i 1)
   (repeat (1- (length handles))
       (setq ent (handent (nth i handles)))
       (setq txt (GetTxt ent))
       (setq Datas (append Datas (list (atof txt))))
       (setq i (1+ i))
   )
   (setq ent (handent (car handles)))
   (setq Result (apply '* Datas))
   (setq ents (entget ent))
   (setq ents (subst (cons 1 (rtos Result)) (assoc 1 ents) ents))
   (entmod ents)
   (princ)
)
(defun MakeReactor (ent)
   (setq circleReactor (vlr-object-reactor (list (vlax-ename->vla-object ent))
                 "Reactor" '((:vlr-modified . Cal))))
)(defun c:Ass( / handles entresult ss handResult ent i)
   (setq handles nil)
   (setq entResult (car (entsel "选择结果数字...")))
   (prompt "选择数据文字...")
   (setq ss (ssget '((0 . "TEXT,MTEXT"))))
   (setq handResult (cdr (assoc 5 (entget entResult))))
   (setq i 0)
   (repeat (sslength ss)
       (setq ent (ssname ss i))
       (setq handles (append handles (list (cdr (assoc 5 (entget ent))))))
       (setq i (1+ i))
   )
   (setq i 0)
   (repeat (length handles)
       (setq ent (ssname ss i))
       (MakeEx ent (cons handResult handles))
       (MakeReactor ent)
       (setq i (1+ i))
   )
   (princ)
)

ljcgq · 发表于 2004-2-9 20:56:00

谢谢斑竹的帮助!!

myfreemind · 发表于 2004-2-9 21:55:00

好程序！！

小菜123 · 发表于 2004-2-10 09:10:00

好程序，这样可以解决不少图纸中的相关数字问题了，我想改一下用到自己的图中，但这个程序有点难，不怎么看得懂，版本能否就每个函数的用途和输入、输出参数作一下说明？谢谢!

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

能在cad窗口中实现象数字相关表格么?

本帖子中包含更多资源