- UID
- 76460
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-9-2
- 最后登录
- 1970-1-1
|
发表于 2005-10-7 21:41:06
|
显示全部楼层
;原名:计算总长度的程序.lsp
(defun C:juzcddcx8(/ CURVE TLEN SS N SUMLEN)
;;来自明经通道
(vl-load-com)
(setq SUMLEN 0)
(setq SS (ssget '((0 . "CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE,ARC"))))
(setq N 0)
(repeat (sslength SS)
(setq CURVE (vlax-ename->vla-object (ssname SS N)))
(setq TLEN (vlax-curve-getdistatparam
CURVE
(vlax-curve-getendparam CURVE)
)
)
(setq SUMLEN (+ SUMLEN TLEN))
(setq N (1+ N))
)
(print (strcat "总长度: " (rtos SUMLEN 2 5)))
(princ)
)
另一个程序:
;;原名:把面积写在图上.lsp
;; write area value of a close polygon to drawing
(DEFUN C:bmjxzts8(/ pen olderr OLDOS PT QAREA )
;;
(PrinC "\n这是对 面积 进行测量的基本程序...")
(Alert "您所选的对象必须由 封闭的PolyLine线组成。 ")
(While (Progn (SetQ pen (Car (EntSel "\n指定一条 PolyLine: ")))
(/= "POLYLINE" (Cdr (Assoc 0 (EntGet pen))))
)
(Alert "所指对象不是 PolyLine,请重新指定...")
)
(setq olderr *error*)
(setq *error* myerr)
(SETVAR "CMDECHO" 0)
(SETQ OLDOS (GETVAR "OSMODE"))
;;
(SETVAR "OSMODE" 0)
;(SETQ STA (CAR (ENTSEL)))
(COMMAND "AREA" "E" pen)
(SETQ QAREA (RTOS (GETVAR "AREA") 2 2))
(SETQ PT (GETPOINT"\n在图上选一点,此为面积文字标注的起点:"))
(COMMAND "TEXT" PT "" "" QAREA)
;;
(SETVAR "OSMODE" OLDOS)
(SETVAR "CMDECHO" 1)
(setq *error* olderr)
(PRINC)
) |
|