请高手帮我修改一个这个程序，谢谢
;;;功能：逐个输出周长和面积(defun C:amm00(/ ss l i totalarea ename obj entareashujuS shujuL)
;;; (setq height(getdist "\n请输入文字高度:") )
(repeat 50 ;循环50次
(if
(null
(if(setq e (entsel "请选择一个对象："))
(progn
(vl-load-com)
(setq modelspace (vla-get-Modelspace (vla-get-activeDocument(vlax-get-acad-object))))
(setq ename(entselname e))
(setq obj(vlax-ename->vla-object ename))
(if(vlax-property-available-p obj "area")
(setq SSS (vlax-get-property obj 'area) ) ;;;;想提取对象的面积
)
(if(=(cdr(assoc 0(entget ename))) "MLINE")
(setq LLL (ml-length entsel))
(setq LLL (vlax-curve-getdistatparam ename(vlax-curve-getendparam ename))) ;;;;想提取对象的周长
)
(setq text1(strcat "S: "(rtos (/ SSS 1000000) 2 2) "m2" "L: "(rtos (/ LLL 1000) 2 2) "m")
)
(if(setq insertpt(getpoint "\n请输入文字插入点: "))
(setq insertp1(vlax-3d-point insertpt)
textobj1 (vla-addtext modelspace text1 insertp1 500)
)
)
)
)
)
(exit)
)
)
)
我是菜鸟, 修改了下,请试下:
;;;功能：逐个输出周长和面积
(defun C:test (/ e ename obj SSS LLL text1 *msp* ins_pt)
; (setq height(getdist "\n请输入文字高度:") )
(while (setq e (entsel "请选择一个对象："))
(vl-load-com)
(setq ename (car e))
(setq obj (vlax-ename->vla-object ename))
(if (vlax-property-available-p obj "area")
(setq SSS (vla-get-area obj)) ;面积
)
(if (= (cdr (assoc 0 (entget ename))) "MLINE")
(setq LLL (vla-get-length obj))
(setq LLL (vlax-curve-getdistatparam
obj
(vlax-curve-getendparam obj)
)
) ;周长
)
(setq text1 (strcat "S= "
(rtos (/ SSS 1.0e6) 2 2) ;实数运算
" m^2"
"L= "
(rtos (/ LLL 1.0e3) 2 2) ;实数运算
" m"
)
)
(if (setq ins_pt (getpoint "\n请输入文字插入点: "))
(progn
(setq *msp*
(vla-get-Modelspace
(vla-get-activeDocument
(vlax-get-acad-object)
)
)
)
(vla-addtext *msp* text1 (vlax-3d-point ins_pt) 500)
(vlax-release-object obj)
(vlax-release-object *msp*)
)
)
)
) 着色不会用, 太凌乱了
页:
[1]