全部评论
(defun c:amjbz (/ AREA_H AREA_WS ERRHAN NEWENTLAST OBJ OBJ_AREA OBJ_I OBJ_NAME OBJ_VLA OLDCMDECHO OLDDELOBJ OLDENTLAST PT)
(command "layer" "M" "面积标注" "C" "7" "" "LT" "CONTINUOUS" "" "")
(vl-load-com)
(setq obj (ssget '((0 . "*POLYLINE"))))
(if obj
(progn
(setq obj_i -1)
(setq oldcmdecho (getvar "cmdecho"))
(setq oldDELOBJ (getvar "DELOBJ"))
(setvar "cmdecho" 0);_禁止回显
(setvar "DELOBJ" 0);_控制创建面域保留原对象
(setq errhan '());_不能创建面域的图元句柄表
(setq area_ws 4);_面积的小数位数
(setq area_h 1);_面积文字的高度
(repeat (sslength obj)
(setq obj_name (ssname obj (setq obj_i (1+ obj_i))));_图元名
(setq obj_vla (vlax-ename->vla-object obj_name));_Vla对象
(if (vlax-curve-isClosed obj_vla);_如果曲线闭合
(setq oldentlast (entlast))
(command "_region" obj_name "");_创建面域
(setq newentlast (entlast))
(if (equal oldentlast newentlast);_如果创建面域不成功
(setq errhan (cons (cdr (assoc 5 (entget obj_name))) errhan))
)
(setq obj_area (vla-get-Area obj_vla));_面积
(setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object newentlast)))))
(command "-text" "j" "mc" pt area_h 0 (rtos obj_area 2 area_ws))
(entdel newentlast)
(if errhan
(princ "\n没有标注面积的图元句柄列表:\n")
(princ errhan)
(setvar "DELOBJ" oldDELOBJ)
(setvar "cmdecho" oldcmdecho)
(princ)
以上内容复制到记事本里,保存为lsp文件(后缀为lsp)。cad里面输入appload加载,然后命令行输入amjbz运行插件。框选需要标注的图形进行面积标注。
距离打开宝箱还剩7天
全部评论