已经上传副件，有劳各位
preone 发表于 2012-8-9 18:26 static/image/common/back.gif
重量=面积x长度x密度
分别赋值，然后列个公式，就出来了~~
赋值用 setq 函数
你好，我上传图档，你看这个样子可以编个程序吗
lohas1118 发表于 2012-8-13 15:56 static/image/common/back.gif
你好，我上传图档，你看这个样子可以编个程序吗
我上传了一张图片，你参考一下，另外，因为是计算价格，对于计算结果的正确与否，你也需要校核一下再用~~
preone 发表于 2012-8-13 19:30 static/image/common/back.gif
我上传了一张图片，你参考一下，另外，因为是计算价格，对于计算结果的正确与否，你也需要校核一下再用~~ ...
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02
命令: tts 输入材料密度(kg/m^3)：.857 输入计算长度或厚度(mm)：02
输入计算面积(mm^2): 选择外框面域或多段线:
选择对象: 找到 1 个
选择对象: 找到 1 个，总计 2 个
选择对象:
逐一选择内部面域或多段线:
选择对象: 找到 1 个
选择对象:
选择对象:
指定输出字高：1
指定插入点:
本帖最后由 preone 于 2012-8-14 18:20 编辑
lohas1118 发表于 2012-8-14 16:38 http://bbs.mjtd.com/static/image/common/back.gif
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02 ...
这个应该不是程序的问题，你以前输入参数时 反着不？还是键盘坏了？
lohas1118 发表于 2012-8-14 16:38 static/image/common/back.gif
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02 ...
在网上找了半天 也没有找到 和你类似的问题 呵呵 看来你只能重新装cad了
还是你加载了什么 反向输出的 插件？
对了 ，上面那个程序有点小bug，我已经在上面的程序里改过来了，你更新一下就好了~~
本帖最后由 chlh_jd 于 2012-8-14 22:18 编辑
(defun c:test(/ ss ssen wk a0l0 a1 l1 str del l p h z en entis ptl c
pt)
;;by GSLS(SS) 2012-8-14
;;图形面积相减并设置密度和厚度,输出文字
(if (and (setq ss (ssget '((0 . "LWPOLYLINE,ELLIPSE,CIRCLE,SPLINE"))))
(setq ssen (ss2lst ss nil))) ;_选择对象
(if(setq
ssen (vl-remove-if-not
(function
(lambda (x)
(or (vlax-curve-isclosed x)
(equal(vlax-curve-getstartpoint x)
(vlax-curve-getendpoint x)
1e-8))))
ssen)) ;_过滤非封闭曲线
(progn
(setq ssen
(mapcar
(function (lambda (x / l)
(setq l (SS:ClosedCurve:GetPoints x 10))
(if (equal (car l) (last l) 1e-8)
(setq l (cdr l)))
(list (vlax-curve-getarea x) l)))
ssen)) ;_计算曲线面积和坐标表
(setq ssen (vl-sort ssen
(function (lambda (e1 e2)
(> (car e1) (car e2)))))) ;_排序
(setq wk (car ssen)
ssen (cdr ssen)
a0 (car wk)
l0 (cadr wk))
;_减法计算
(if ssen
(foreach assen
(setq a1 (car a)
l1 (cadr a))
(if
(not (vl-some (function (lambda (x)
(< (pipl? x l0 1e-8) 0)))
l1))
(setq a0 (- a0 a1)))))
(if
(and
a0
(not (minusp a0))
(not (prompt
"\n输入密度kg/m^3和厚度mm(空格或分号逗号隔开):"))
(setq str (lm:getstring "7850 20"))
(cond ((wcmatch str "* *")
(setq del " "))
((wcmatch str "*;*")
(setq del ";"))
((wcmatch str ",")
)
((setq del "-")))
(setq l (mapcar 'atof (string->strlst str del)))
(setq p (car l))
(setq h (cadr l))
) ;_条件输入
(progn
(setq z (* a0 h p 1e-9))
(setq str (strcat (rtos z 2 3) " kg"))
(setq en (my_entsel "\n选择要修改的文字对象或点:"
(list (cons 0 "TEXT"))
nil))
(setq p (car en))
(if (cadr en)
(entmod (setq ent (entget (cadr en))
ent (subst (cons 1 str) (assoc 1 ent) ent)))
(if (and(setq en
(entmakex (list (cons 0 "TEXT")
(cons 1 str) ;_文字内容
(cons 10 (trans p 1 0)) ;_插入点
(cons 72 0) ;_
(cons 73 1) ;_72 73对正样式,左对齐
(cons 62 256) ;_文字颜色,随层
(cons 40 300.) ;_文字高度
(cons 41 0.7) ;_文字宽度
(cons 50 0.0) ;_文字旋转角度
(cons 7 "STANDARD") ;_文字样式
)))
(setq ent (entget en))
(setq is t))
(whileis
(setq ptl (grread t 15 0))
(setq c (car ptl))
(cond
((= c 5)
(setq pt (cadr ptl))
(setq ent(subst (cons 11 pt)
(assoc 11 ent)
ent))
(entmod ent)
(entupd en)
)
((= c 3)
(setq is nil)
)
) ;_cond
) ;_while
) ;_if
) ;_if
(princ (strcat "\n面积与密度换算重量为" str "。"))
) ;_progn
(princ "\n未输入密度和厚度。")
) ;_if
) ;_progn
(princ "\n选择对象类型错误,未包含封闭曲线。")
) ;_if
(princ "\n未选择对象,请重新执行命令。")
) ;_if
(princ)
) ;_defun
;;;配套函数
;;;转换选择集为表
(defun ss2lst(ss vla / a e i)
(if (= (type ss) (quote PICKSET))
(progn
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(if vla
(setq e (vlax-ename->vla-object e))
nil)
(setq a (cons e a))))
nil))
;;;判断点是否在封闭多边形内 .
;;;Function : judge a point location with polygon
;;;Arg : pt -- a point
;;; pts -- points of polygon
;;; eps -- allowance
;;;return :
;;; -1 -- out of polygon , 0 -- at , 1 -- in
(defun pipl?(pt pts eps / is at a)
;; by 狂刀
;; Edit by GSLS(SS) 2011.03.28
;; Solved the problem : if a point at the given polygon , it perhap return T or NIL .
(if (vl-some (function (lambda (x) (equal x pt eps))) pts)
0
(progn (setq is
(equal
PI
(abs
(apply
(function +)
(mapcar
(function (lambda (x y / a)
(setq a
(rem (- (angle pt x) (angle pt y))
PI))
(if (equal (+ (distance pt x)
(distance pt y))
(distance x y)
Eps)
(setq at T))
a))
(cons (last pts) pts)
pts)))
eps))
(cond (at 0)
(is 1)
(T -1)))))
;;字符串转为表
(defun string->strlst(str del / lst a s1 cha pos i)
(setqs1 ""
i0
a(ascii del))
(while (setq pos (vl-string-position a str i))
(setq s1 (substr str (1+ i) (- pos i)))
(if(/= s1 "")
(setq lst (cons s1 lst)))
(setq i (1+ pos)))
(setq s1 (substr str (1+ i)))
(if (/= s1 "")
(setq lst (cons s1 lst)))
(reverse lst))
;;封闭曲线取点函数
(defun SS:ClosedCurve:GetPoints (en acc / ent et)
;;by GSLS(SS)
(setq
ent(entget en)
et(cdr (assoc 0 ent)))
(cond
((= et "LWPOLYLINE")
((lambda (/ a b vetex bu p1 p2 l r ang an1 N)
(while (setq ent (member (assoc 10 ent) ent))
(setqb (cons (cdar ent) b)
ent (member (assoc 42 ent) ent)
b (cons (cdar ent) b)
ent (cdr ent)
vetex (cons b vetex)
b nil))
(while vetex
(setqa (car vetex)
vetex (cdr vetex)
bu (car a)
p1 (cadr a))
(if l
(setq p2 (car l))
(setq p2 (cadr (last vetex))))
(if (equal bu 0 1e-6)
(setq l (cons p1 l))
(progn
(setq ang(* 2 (atan bu))
r(/ (distance p1 p2)
(* 2 (sin ang))
)
c(polar p1
(+ (angle p1 p2) (- (/ pi 2) ang))
r
)
r(abs r)
ang(abs (* ang 2.0))
N(abs (fix (/ ang 0.0174532925199433)))
N(min N (1+ Acc)))
(if (= N 0)
(setq l (cons p1 l))
(progn
(setqan1 (/ ang N)
ang (angle c p2)
)
(if (not (minusp bu))
(setq an1 (- an1))
)
(repeat (1- N)
(setq ang (+ ang an1)
l (cons (polar c ang r) l)
)
)
(setq l (cons p1 l)))))))
l)))
((= et "CIRCLE")
((lambda (c R / sa l)
(setq sa 0.0)
(repeat180
(setql(cons (polar c sa R) l)
sa (+ sa 0.0174532925199433)))
(setq l (reverse l))
(append
l
(mapcar
(function
(lambda (p)
(mapcar (function +) c (mapcar (function -) c p))))
l
)))
(cdr (assoc 10 ent))
(cdr (assoc 40 ent))))
((= et "SPLINE")
((lambda (/ r _oce)
(setq _oce (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (vl-catch-all-apply
(function vl-cmdf)
(list "_PEDIT"
(vlax-vla-object->ename
(vla-copy (vlax-ename->vla-object en))
)
""
acc
""))
(progn
(setq l (ss-assoc 10 (entget (setq r (entlast)))))
(if(vlax-curve-isClosed r)
(setq l (append l (list (car l)))))
(entdel r)))
(setvar "CMDECHO" _oce)
l)))
((= et "ELLIPSE")
((lambda (/ e l _os)
(setq _os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object en) 0.1))
(setq e (entlast))
(vl-catch-all-apply
(function vla-offset)
(list (vlax-ename->vla-object (entlast)) -0.1))
(entdel e)
(setq e (entlast))
(setq l (ss-assoc 10 (entget e)))
(entdel e)
(setvar "OSMODE" _os)
l)))))
;;
;;;by Lee Mac
(defun LM:GetString(#Default / dcTag result)
(cond((<= (setq dcTag (load_dialog "ACAD")) 0))
((not (new_dialog "acad_txtedit" dcTag)))
(t
(set_tile "text_edit" #Default)
(action_tile
"accept"
"(setq result (get_tile \"text_edit\")) (done_dialog)")
(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog dcTag)))
result)
;; 【索引表查找】全部
;;;获取表中索引码相同的所有元素
;;;ss-assoc 最快
(defun ss-assoc (a lst / b res)
(while (setq b (assoc a lst))
(setq lst (cdr (member b lst))
res (cons (cdr b) res)
))
(reverse res))
;;
(defun my_entsel
(STR FILTER PRO / PT SS_NAME SS old_modemacro)
(setq old_modemacro (getvar "MODEMACRO"))
(if (/= (type STR) (quote STR))
(progn
(princ "\n变量类型不对，STR应为字符串。\n")
(eval NIL))
(progn
(if (/= (type FILTER) (quote list))
(progn
(princ "\n变量类型不对，FILTER应为表。\n")
(eval NIL))
(progn
(princ STR)
(setvar "MODEMACRO" STR) ;_这里添加选择修改
(setqPT (grread t 4 2)
is_go_on t)
(while (and (/= 3 (car PT))
(/= 11 (car PT))
(/= 25 (car pt))
is_go_on)
(cond
((and (= 2 (car pt))
(or (= 13 (cadr pt)) (= 32 (cadr pt)))) ;_Enter,Space.
(setq is_go_on nil))
((and (= 2 (car pt))
(or (= 115 (cadr pt)) (= 83 (cadr pt)))) ;_S set arg.
(eval pro)
(princ STR))
((and (= 5 (car PT)) (vl-consp (cadr PT)))
(setq SS (ssget (cadr PT) FILTER))
(if SS_NAME
(redraw SS_NAME 4))
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(redraw SS_NAME 3))
(setvar "MODEMACRO" old_modemacro)))
) ;_cond
(setq PT (grread t 4 2))
) ;_while
(setvar "MODEMACRO" old_modemacro)
(if (and (/= 11 (car pt)) (/= 25 (car pt)))
(progn
(setq PT (cadr PT))
(setq SS (ssget PT FILTER))
(setvar "LASTPOINT" PT)
(if SS_NAME
(redraw SS_NAME 4)
)
(setq SS_NAME NIL)
(if SS
(progn
(setq SS_NAME (ssname SS 0))
(list (trans PT 1 0) SS_NAME))
(list (trans PT 1 0))))
(ifss_name
(redraw ss_name 4))))))))
狂刀厉害的
完美，如果能指定字高就更完美了！
chlh_jd 发表于 2012-8-14 22:00 static/image/common/back.gif
请教下像这种图形，用这个怎么算不出来。