请解读下下面的LSP程序,是在CAD中运行,用来标注面积的。

请解读下下面的LSP程序,是在CAD中运行,用来标注面积的。,第1张

(defun c:qq (/ d ent f i lst m2 obj pt ss txt x y)

  (defun maketext (txt pt) 生成文字子函数

    (entmake (list '樱做(0 . "TEXT") (cons 62 1) (cons 10 pt) (cons 40 10) (cons 1 txt) '(41 . 0.8)))写文字,0表示字体,62表示颜色1红,10表示坐标点,40表示高度,1表示文字内容,41表示文字宽度比例

  )

  (setvar "cmdecho" 0)关闭命令行提示

  (vl-load-com)加载vlax扩展函数

  (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)))转换直线为vla对象并取得质心

            m2 (rtos (vla-get-area obj) 2 2) d (rtos (vla-get-perimeter obj) 2 2) lst (cons (list pt m2 d) lst)取得面积平方毫米,长度毫米,并建立一个列表

      )

    )

  )

  (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 "w"))建立文本

  (write-line "编号\t周长(mm)\t面积(㎡)" f)写入内容

  (setq i 1)文字编号

  (foreach x lst

    (setq pt (car x) m2 (cadr x) d (caddr x))每一个元素按顺序对应

    (maketext (strcat "A" (itoa i)) (list (car pt) (+ (cadr pt) 20)))通过子程序写文字编号

    (maketext (strcat "L=" d "m") pt)通过子程序写长度这个"m"应当为"mm"

    (maketext (strcat "S=" m2 "㎡") (list (car pt) (- (cadr pt) 14)))面积"㎡"应当为"mm²"

    (write-line (strcat (strcat "A" (itoa i)) "\t" d "\t" m2) f)3个字符串写入文本

    (setq i (1+ i))编号递增

  )

  (close f)关闭文本

  (princ)沉默结束

)

依次选中封闭图形,用命令:list查询

网上有面积标注插件,可以下载

或者将下面的lisp代码复制到记事本里,保存为:面积标注.lsp

在cad里加载后,用高丛知car运行插件

(defun c:car ( / o1 ipt opp parea)

(setq clyer(getvar"clayer"))

(command "layer" "m" "郑高范围线"戚消 "")

(command "layer" "c" "2" "范围线" "")

(command "color" "bylayer")

(setq ipt (getpoint "\n 选择内部点: "))

(command "-Boundary" ipt"" "")

(setq o1 (entlast))

(redraw o1 3)

(command "area" "O" "L")

(setq opp (getvar "area"))

(initget 1)

(setq parea(getpoint"\n 选择面积标注位置"))

(command "layer" "m" "area text" "")

(command "layer" "c" "81" "area text" "")

(command "color" "bylayer")

(initget 1)

(command "text" parea "1"0 (rtos opp 2 3)) "这个三是位数"

(setq elast(entlast))

(command "scale" elast"" parea)

(setvar"clayer"clyer)

)

面积的单位一般是平方米,在AutoCAD里面,可以用文字的返指方式写面积到面域里面,可以写一个程序来解决问题,程序如下:

(defun C:tes ( / &dis1 &k1 &kw1 m2 obj pt)

 (setq &dis1 (getdist (strcat "\n请文字高度默认高度:<" "50" ">")))

 (if (or (= &dis1 0) (= &dis1 nil)) (setq &dis1 50) (setq &dis1 (abs &dis1)) )

 (if (setq &kw1 (ssget '((0 . "REGION"))))如果有选择了面域

  (progn

   (while (setq &k1 (ssname &kw1 0))

    (setq &kw1 (ssdel &k1 &kw1))

    (setq obj (vlax-ename->vla-object &k1))转换为vlax对象

    (setq pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj))))取得面域的质心点

   耐闭 (setq m2 (vla-get-area obj))取得面域面积

    (setq m2 (* m2 0.000001))面积转换为平方米,不需要转换就删除这句话

    (setq m2 (rtos m2 2 5))保留小数点后5位

    (entmake (list '(0 . "TEXT") (cons 1 m2) (cons 40 &dis1) (cons 10 pt) '(72 . 4) (cons 11 pt)))文字写在质心点位置

   )

  )

 昌世裂)

 (prin1)

)复制到记事本,以【.lsp】为后缀命名,打开CAD,autolisp加载,命令【TES】


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/yw/12357097.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存