chlh_jd 发表于 2012-8-14 22:00 static/image/common/back.gif
学习~~
lohas1118 发表于 2012-8-14 16:38 static/image/common/back.gif
你好，我用的是2004版的CAD，输入的参数都是反着的。
第一个数值会跑到最后面，7.85变成.857,20变成了02 ...
在上次发的那个程序里更新了~
lohas1118 发表于 2012-8-15 17:17 static/image/common/back.gif
请教下像这种图形，用这个怎么算不出来。
因为图形不是面域或者多段线~~
需要 pe 做成多段线 或者 reg 做成面域就可以了~~
本帖最后由 lohas1118 于 2012-8-16 16:52 编辑
preone 发表于 2012-8-15 18:09 http://bbs.mjtd.com/static/image/common/back.gif
因为图形不是面域或者多段线~~
需要 pe 做成多段线 或者 reg 做成面域就可以了~~
试过了，但算出来答案是0.000 kg。是不是太小了算不出来。
材料是C2680,厚度0.2 您试下。
lohas1118 发表于 2012-8-16 16:48 static/image/common/back.gif
试过了，但算出来答案是0.000 kg。是不是太小了算不出来。
材料是C2680,厚度0.2 您试下。
恩 我试过了，是太小了 呵呵
我把小数位数调到6位，就可以显示出来了~~
上面的程序已经改过来了 你更新一下~~
如果是这种方式，可以通过面域求解，以下简单写了个示意；
您可以根据需要自己修改调整下，比如可以采用人工控制是否采用面域算法（例中采用了图元数大于10为界）
(defun c:test(/ ss ssen wk a0 l0 a1 l1 str del l p h z en ent is ptl c pt en ssobj )
;;by GSLS(SS) 2012-8-14
;;图形面积相减并设置密度和厚度,输出文字
(if (and (setq ss (ssget '((0 . "LWPOLYLINE,ELLIPSE,CIRCLE,SPLINE,LINE,ARC")))) ;_选择对象
(setq ssen (ss2lst ss nil)))
(progn
(if (< (length ssen) 10) ;_如果对象数量多于10 按面域计算,这里您可以自己设定
(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
) ;_progn
(princ "\n选择对象类型错误,未包含封闭曲线。")
) ;_if
(progn
(setq en (entlast))
(if (not (vl-catch-all-error-p
(vl-catch-all-apply
(function
vl-cmdf)
(list
"_Region"
ss ""))))
(progn
(setq ssen nil)
(while (setq en (entnext en))
(setq ssen (cons en ssen)))
(setq ssobj (mapcar 'vlax-ename->vla-object ssen))
(setq ssobj
(vl-remove-if-not
(function (lambda (x)
(eq (vla-get-objectname x)
"AcDbRegion")))
ssobj))
(setq
ssobj (vl-sort
ssobj
(function (lambda (e1 e2)
(> (vla-get-area e1)
(vla-get-area e2)))))) (while (cadr ssobj)
(vla-boolean
(car ssobj)
acSubtraction
(cadr ssobj)
)
(setq ssobj (cons (car ssobj) (cddr ssobj)))
)
(setq a0 (vla-get-area (car ssobj)))
(vl-cmdf "_EXPLODE"
(vlax-vla-object->ename (car ssobj)))
))))
(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 3.) ;_文字高度
(cons 41 0.7) ;_文字宽度
(cons 50 0.0) ;_文字旋转角度
(cons 7 "STANDARD") ;_文字样式
)))
(setq ent (entget en))
(setq is t))
(while is
(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未输入密度和厚度。")
)
)
(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)
(setq s1 ""
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))
(setq b (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
(setq a (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
(setq an1 (/ 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)
(repeat 180
(setq l(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) ;_这里添加选择修改
(setq PT(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))))
(if ss_name
(redraw ss_name 4))))))))
preone 发表于 2012-8-16 17:12 static/image/common/back.gif
恩 我试过了，是太小了 呵呵
我把小数位数调到6位，就可以显示出来了~~
上面的程序已经改过来了 你更新 ...
万分感谢
本帖最后由 preone 于 2012-8-17 19:30 编辑
lohas1118 发表于 2012-8-17 13:55 http://bbs.mjtd.com/static/image/common/back.gif
万分感谢
(defun c:tts (/ osold midu changdu wks nbsh ssn scha tg pt dj zl zj)
(setvar "cmdecho" 0)
(setq osold (getvar "osmode"))
(setvar "osmode" 0)
(setq midu(getreal "输入材料密度(kg/m^3)："))
(setq changdu(getreal "输入计算长度或厚度(mm)："))
;下部分为求面积部分
(if (null (setq scha (getreal "输入计算面积(mm^2):")))
(progn
(prompt "选择外框面域或多段线:")
(command "area" "e" (ssget '((0 . "REGION,LWPOLYLINE,CIRCLE"))))
(setq wks (getvar "area"))
(prompt "逐一选择内部面域或多段线:")
(setq nbsh 0)
(while
(setq ssn (ssget'((0 . "REGION,LWPOLYLINE,CIRCLE"))))
(command "area" "e" ssn)
(setq nbsh (+ (getvar "area") nbsh))
)
(setq scha (- wks nbsh))
)
)
;end求面积部分
(or (setq tg (getreal "指定输出字高<空格跳过>:")) (setq tg (* (getvar "dimscale") 1.6)))
(or (setq dj (getreal "\n输入材料单价<默认1,空格跳过>:")) (setq dj 1))
(setq zl (/ (* scha changdu midu) 1000000)
zj (* dj zl))
(setq pt (getpoint"\n指定插入点:"))
(command "text" "s" "宋体" (polar pt (/ pi 2) (* tg 1.6)) tg "0" (strcat "重量=" (rtos zl 2 6) "kg"))
(command "text" "s" "宋体" pt tg "0" (strcat "单价=" (rtos dj 2 6) "元/kg"))
(command "text" "s" "宋体" (polar pt (/ pi -2) (* tg 1.6)) tg "0" (strcat "总价=重量x单价=" (rtos zj 2 6) "元"))
(setvar "osmode" osold)
(prin1)
)
加上材料单价输入项目，另外 因为原来的字体识别不了汉字，所以我把字体改成了 “宋体” 不知道你的cad能不能识别..
程序默认的单价是1，你使用时注意一下~~
真的太好了
chlh_jd 发表于 2012-8-14 22:00 static/image/common/back.gif
老大你这个程序可不可以帮我改组一下，用来计算钢板重量
1框选图形
2输入密度（这时程序有选项可供选择，ABAD,,,分别代表不同的密度值）设这么个选项架构即可，具体的选项内容我来填冲
3输入厚度
4计算（计算时加个倍率乘法，例如乘以1.2 或 乘以1.5，具体多少由人工输入）
5程序结束，在屏幕上插入文本（文本最好含 密度，厚度 倍率数值 和作为计算结果的重量数值）