[求助]：求从图中点取算式进行计算的程序！

nt8011 · 发表于 2009-1-17 13:30:51

eachy斑竹给的程序很好用，非常感谢！！！

zx0sl · 发表于 2009-1-17 22:12:32

15楼eachy斑竹的程序很好用，但是CAD中一般很少用到这种列表达式的吧，如果改成选取图中数字组合成表达式是否更有用

nt8011 · 发表于 2009-1-17 23:25:23

很有用，在总图中要很多次的计算指标，点取图中封闭线的面积后，对面积数据改成一个计算式，把计算结果再标在图中。一直在完善这个功能，eachy斑竹给的程序是其中重要的一步。
另： eachy斑竹，因为还需对计算结果进行求和或其它操作，所以期望保留算式，把计算结果另外独立标在后面。我准备在贵程序后采用文字打断的方法来实现（汗颜...），如eachy斑竹能有简单的办法来调整，敬请指点！！！
另： 17楼提出“改成选取图中数字组合成表达式”的想法很创意，应该对平时工作有帮助，期望哪位大侠的手笔了。

zml84 · 发表于 2009-1-18 13:18:45

我要流汗了。。

xyp1964 · 发表于 2009-1-18 14:33:45

;;修改完善

[FONT=courier new];; 算式文本计算
(defun c:test767 (/ ss i s1 tx a)
(cmdla0)
(xyp-initSet '(INT) '(3))
(SETQ INT (UINT 5 "" "计算精度" INT))
(if (not (member "geomcal.arx" (arx)))
(arxload "geomcal.arx")
)
(setq ss (ssget '((0 . "text")))
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq tx (xyp-get-dxf 1 s1))
(if (setq a (c:cal tx))
(xyp-SubUpd s1 1 (strcat tx " = " (rtos a 2 INT)))
)
)
(cmdla1)
)[/FONT]

eachy · 发表于 2009-1-18 14:41:05

(defun c:tt (/ ss ssl i e str el nstr p p1 ll l)
(if (not (member "GEOMCAL.ARX" (MAPCAR 'strcase (arx))))
(arxload "geomcal.arx")
)
(if (and (setq ss (ssget '((0 . "text"))))
(setq p (getpoint "\nOutput Point: "))
)
(progn
(setq ssl (sslength ss)
i -1
)
(repeat ssl
(setq el (entget (ssname ss (setq i (1+ i))))
str (cdr (assoc 1 el))
l (caadr (textbox (list (assoc 1 el) (assoc 40 el))))
ll (+ l (* 3. (/ l (strlen (cdr (assoc 1 el))))))
nstr (rtos (c:cal str) 2 2)
)
(setq el (subst (cons 10 p) (assoc 10 el) el))
(entmake el)
(setq el (subst (cons 1 nstr) (assoc 1 el) el)
p1 (mapcar '+
(list ll 0. 0.)
p
)
el (subst (cons 10 p1) (assoc 10 el) el)
)
(entmake el)
(setq
p (mapcar '+ p (list 0. (- (* 1.5 (cdr (assoc 40 el)))) 0.))
)
)
)
)
(princ)
)

(defun c:tt (/ ss ssl i e str el nstr p p1 ll l) 
  (if (not (member "GEOMCAL.ARX" (MAPCAR 'strcase (arx)))) 
    (arxload "geomcal.arx") 
  ) 
  (if (and (setq ss (ssget '((0 . "text")))) 
           (setq p (getpoint "\nOutput Point: ")) 
      ) 
    (progn 
      (setq ssl        (sslength ss) 
            i        -1 
      ) 
      (repeat ssl 
        (setq el   (entget (ssname ss (setq i (1+ i)))) 
              str  (cdr (assoc 1 el)) 
              l           (caadr (textbox (list (assoc 1 el) (assoc 40 el)))) 
              ll   (+ l (* 3. (/ l (strlen (cdr (assoc 1 el)))))) 
              nstr (rtos (c:cal str) 2 2) 
        ) 
        (setq el (subst (cons 10 p) (assoc 10 el) el)) 
        (entmake el) 
        (setq el (subst (cons 1 nstr) (assoc 1 el) el) 
              p1 (mapcar '+ 
                         (list ll 0. 0.) 
                         p 
                 ) 
              el (subst (cons 10 p1) (assoc 10 el) el) 
        ) 
        (entmake el) 
        (setq 
          p (mapcar '+ p (list 0. (- (* 1.5 (cdr (assoc 40 el)))) 0.)) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

nt8011 · 发表于 2009-1-18 19:12:39

eachy斑竹的程序完全符合我所需的功能，谢谢！！！也谢谢其它热心的斑竹们！
感受到：晓东论坛因为有你们一群水平高且热心的斑竹，使论坛能一直保持精彩！

clhclh · 发表于 2009-1-19 12:34:03

最初由 eachy 发布
[B][code]
(defun c:tt (/ ss ssl i e str el nstr p p1 ll l)
  (if (not (member "GEOMCAL.ARX" (MAPCAR 'strcase (arx))))
(arxload "geomcal.arx")
  )
  (if (and (setq ss (ssget '((0 . "text"))))
   ... [/B]

如果我要在表达式后加上个“=”，要怎么改代码？

zml84 · 发表于 2009-1-20 08:26:11

示例：

gotosealiu · 发表于 2009-2-6 11:35:06

我看要达到你的目的，只能先选择文字实体，提取出内容，分解数字和运算符号，再求解，最后把结果用文字实体放到图中，

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

[求助] [求助]：求从图中点取算式进行计算的程序！