求助：经典输出面积与周长源码，langjs写的
既然发消息给我那就编一个。使用时不保证100％正确。;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ d ent f i lst m2 obj pt ss txt x y)
(setq TextHeight (getdist "\n输入标注文字高度:")
Textbh (getstring "\n输入编号前缀:"))
(defun maketext (txt pt) ; 生成文字子函数
(entmake (list '(0 . "TEXT") (cons 62 1) (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)))
)
(setvar "cmdecho" 0)
(vl-load-com)
(setq ss (ssget) ent (entlast))
(command ".region" ss "")
(setq ss (ssadd)lst nil)
(while (setq ent (entnext ent))
(if (= (cdr (assoc 0 (entget ent))) "REGION")
(setq obj (vlax-ename->vla-object ent) pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))
m2 (rtos (vla-get-area obj) 2 2) d (rtos (vla-get-perimeter obj) 2 2) lst (cons (list pt m2 d) lst)
)
)
) （setq txt (vla-get-perimeter obj))
(command ".undo" "")
(setq lst (vl-sort lst (function (lambda (x y)(< (car (car x)) (car (car y)))))))
(setq lst (vl-sort lst (function (lambda (x y)(> (cadr (car x)) (cadr (car y)))))))
(setq f (getfiled "指定输出文件路径" "" "xls" 1) f (open f "a"))
(write-line "编号\t周长(mm)\t面积(mm2)" f)
(setq i 1)
(foreach x lst
(setq pt (car x) m2 (cadr x) d (caddr x))
(maketext (strcat Textbh (itoa i)) (list (car pt) (+ (cadr pt) (* 1.2 TextHeight))))
(maketext (strcat "L=" d "mm") pt)
(maketext (strcat "S=" m2 "mm2") (list (car pt) (- (cadr pt) (* 1.2 TextHeight))))
(write-line (strcat (strcat Textbh (itoa i)) "\t" d "\t" m2) f)
(setq i (1+ i))
)
(close f)
(princ)
)
红色的那句是我自已加的，程序可以通过，但是不知道为什么提示那句表达式：错误: 参数类型错误: streamp nil，想了好久，本人实在木瓜脑壳想不出来，只能求助大师，如果要那句话定义，不知道如何写？？？
本帖最后由 yxp 于 2018-4-24 22:34 编辑
;; 功能： 输出封闭多边形边长及面积 到 EXCEL 文件
;; 编写： yxp 2017-3-31 QQ：9034598
;; (vla-get-area (vlax-ename->vla-object (car (entsel "\n选择多段线: "))))
(vl-load-com)
(defun c:mjs ( / ent ob S L A d H xy xzz old)
(setq old (getvar "osmode") ent (entlast))
(mapcar '(lambda(x)(setvar x 0))(list "cmdecho" "osmode" "delobj"))
(vl-cmdf "_region" (ssget ":L") "")
;(vla-AddRegion )
(while (setq ent (entnext ent))
(setq ob (vlax-ename->vla-object ent)
L (vla-get-perimeter ob)
A (vla-get-Area ob)
H (/ (sqrt A) 12.0)
S (cdr (assoc 5 (entget ent))) ;; (itoa (if n (setq n (1+ n))(setq n 1)))
d (cons (list S L A) d)
xy (vlax-safearray->list (vlax-variant-value (vla-get-centroid ob)))
xy (polar xy 0 (* -4.0 H))
xzz (cons (list (list S (list (car xy)(+ (cadr xy) (* 1.5 H))) H)
(list (strcat "S= " (rtos L 2)) xy H)
(list (strcat "C= " (rtos A 2))(list (car xy)(- (cadr xy)(* 1.5 H))) H)) xzz))
(entdel ent)
)
(foreach x xzz (foreach y x (apply 'MxTxt y)))
(if d (SaveExcel (cons '("编号" "周长" "面积") (reverse d))))
(setvar "osmode" old)
(princ)
)
(defun SaveExcel( Lit / a r c d)
(if (null *appxls*) (princ "\n程序首次运行需要打开 excel 程序，请耐心等候..."))
(setq *appxls* (vlax-get-or-create-object "excel.application"))
(setq a (vl-catch-all-error-p (vl-catch-all-apply 'vlax-get-property (list *appxls* "sheets"))))
(vlax-invoke-method (vlax-get-property *appxls*(if a "workbooks" "sheets")) "add")
(setq newite (vlax-get-property (vlax-get-property *appxls* "sheets") "item" 1)
xlscells (vlax-get-property newite "cells")
r 0 c 0)
(vla-put-visible *appxls* 1)
(repeat (length Lit)
(setq d (nth r Lit) r (1+ r))
(repeat (length d)
(vlax-put-property xlscells "item" r (1+ c)
(vl-princ-to-string (nth c d)))
(setq c (1+ c))
)(setq c 0)
)
(vlax-release-object xlscells)
(vlax-release-object newite)
(vlax-release-object *appxls*)
)
(defun MxTxt(s p H)(entmake (list '(0 . "TEXT")(cons 1 s)(cons 10 p)(cons 40 H))))
(princ "\n文件加载成功，请输入 mjs 命令")
(princ) yxp 发表于 2018-4-24 22:30
谢谢回复， 我想知道上面那句（setq txt (vla-get-perimeter obj))，不对的话，我改用了
(setq str "d")
(atof str) 就是想取"d"这个字符串来转成实数进行加减，可是还是不可以，不知道如何才行呢 ？？ 不语勿语 发表于 2018-4-24 22:42
谢谢回复， 我想知道上面那句（setq txt (vla-get-perimeter obj))，不对的话，我改用了
(setq str "d") ...
(atof "d")返回 0.0有什么意义？ ，在这个程式里，选取图形后，那个d输出的是周长数值，我就是想提取这个数值进行四则运算 四则运算可以用字符串 strcat 组成表达式，比如 "(+ 5 5)" ，数字可以是变量，然后用下面函数求值。
(eval (read "(+ 5 5)"))
不明白，举个例子
(setq cc 20 vv100 )
(setq xx(/ ( (eval (read "+d")) (* cc (* vv )) ) 1) )；；；这样表达可以吗:loveliness: 本帖最后由 yxp 于 2018-4-24 23:50 编辑
不语勿语 发表于 2018-4-24 23:31
不明白，举个例子
(setq cc 20 vv100 )
(setq xx(/ ( (eval (read "+d")) (* cc (* vv )) )...
汗，搞了半天你对 lisp 一窍不通啊，你那表达式，语法都不对。
(* vv ) 少个乘数，能这么写吗？
多看看基础语法。
我又试了一下， (* vv ) 返回 vv
:lol少写了
(setq cc 20 vv100 )
(setq xx(/ ( *(eval (read "+d+")) (* cc (* vv )) ) 1) ) 不懂呀，呵呵，能说明白点不
页:
[1]
2