设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 小程序报错：点击矩形，自动生成面积和重量标注
12下一页
返回列表 发新帖
查看: 2056|回复: 16

[提问] 小程序报错：点击矩形，自动生成面积和重量标注

[复制链接]
xvbzcmn
发表于 2020-12-3 19:49:37 | 显示全部楼层 |阅读模式
请问各位前辈，我想写一个小程序，实现：点击一矩形，自动在矩形中心处生成面积和重量的标注。以下是我撰写的程序，但是报错了：错误: 参数类型错误: lentityp nil，请问是什么原因呢？代码如下：
  2. (defun c:zs ()
  3.   (vl-load-com)
  4.   (setvar "cmdecho" 0)
  5.   (setvar "blipmode" 0)
  6.   (setvar "osmode" 0)

  8.   (setq en1 (entsel "Select an object:"))
  9.   (setq bh (getreal "Enter the first number:")
  10.   ch (getreal "Enter the second number:")
  11.   )
  12.   (setq en_data (entget (car en)))
  13.   (setq lx (cdr (assoc 0 en_data)))

  15.   (if (= lx "LWPOLYLINE")
  16.     (progn
  17.       (setq p1 (cdr (assoc 10 en_data)))
  18.       (setq listlength (length en_data))
  19.       (setq p2 (cdr (nth (- listlength 13) en_data)))
  20.       (setq p3 (cdr (nth (- listlength 9) en_data)))
  21.       (setq p4 (cdr (nth (- listlength 5) en_data)))
  22.       (setq midp (list (/ (+ (car p1) (car p3)) 2) (/ (+ (cadr p1) (cadr p3)) 2) 0))
  23.       (setq b1 (distance p1 p2))
  24.       (setq b2 (distance p2 p3))
  25.       (setq area (/ (* b1 b2) 1000000))
  26.       (setq weight (* (* area 0.06) 2.5))
  27.       (setq context1 (strcat (rtos area) "平," (rtos weight) "t"))
  28.       (entmake (list
  29.          '(0 . "TEXT")
  30.          '(100 . "AcDbEntity")
  31.          '(100 . "AcDbText")
  32.           (cons 11 (setq d1 (polar midp (* 1.5 pi) 330)))
  33.           (cons 10 (polar d1 pi 700))
  34.           (cons 40 300)
  35.           (cons 1 context1)
  36.          )
  37.        )
  38.     )
  39.   )
  40.   (princ)
  41. )




回复

使用道具 举报

yshf
发表于 2020-12-5 22:43:31 | 显示全部楼层
rocking2008 发表于 2020-12-5 22:12
长老，能否加入圆、多边形、PL线画的封闭区域这3个对象。目前只能支持矩形。

(defun c:plzsA()
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (command "_undo" "be")
  (if (progn
           (princ "\n请选取圆、封闭多段线:")
                 (setq ssa (ssget '((0 . "LWPOLYLINE,CIRCLE"))))
      )
      (progn
         (setq i 0)
         (repeat (sslength ssa)
             (setq ent (ssname ssa i))
             (setq obj (vlax-ename->vla-object ent))
             (setq dxf (entget ent))
             (setq name (cdr (assoc 0 dxf)))
             (setq area (/ (vlax-curve-getArea obj) 1000000.0))
             (cond ((= name "CIRCLE")
                       (setq pmid (cdr (assoc 10 dxf)))
                   )
                   ((= name "LWPOLYLINE")
                       (If (= (vlax-get obj "Closed") -1)
                           (progn
                                (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
                                (setq pmid (mapcar '/ (apply 'mapcar (cons '+ pts))
                                                      (list (length pts) (length pts))
                                           )
                                )
                           )
                           (setq pmid nil)
                       )
                  )
             )          
             (If (/= pmid nil)
                 (progn
                     (setq weight (* (* area 0.06) 2.5))
                     (setq context1 (strcat (rtos area) "平," (rtos weight) "t"))
                     (entmake (list
                                    '(0 . "TEXT")
                                    '(100 . "AcDbEntity")
                                    '(100 . "AcDbText")
                                     (cons 1 context1)
                                     (cons 10 pmid)
                                     (cons 11 pmid)
                                     (cons 40 300) '(41 . 1.0)
                                     (cons 50 0.0) '(51 . 0.0)
                                    '(71 . 0) '(72 . 1) '(73 . 2)
                               )
                      )
                 )
             )
          
             (setq i (1+ i))
         )
     )   
  )
  (command "_undo" "e")
  (princ)
)
回复 支持 1 反对 0

使用道具 举报

yshf
发表于 2020-12-4 08:56:22 | 显示全部楼层
bai2000 发表于 2020-12-4 08:40
楼上的不错，能批量更好

(defun c:plzs()
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (command "_undo" "be")
  (if (progn
           (princ "\n请选取矩形:")
           (setq ssa (ssget  '((0 . "LWPOLYLINE")(90 . 4))))
      )
      (progn
         (setq i 0)
         (repeat (sslength ssa)
             (setq ent (ssname ssa i))
             (setq dxf (entget ent))
             (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
             (setq pmid (mapcar '(lambda( a b)(* 0.5 (+ a b))) (car pts) (caddr pts)))
             (setq area (/ (vlax-curve-getArea ent) 1000000.0))
             (setq weight (* (* area 0.06) 2.5))
             (setq context1 (strcat (rtos area) "平," (rtos weight) "t"))
             (entmake (list
                                '(0 . "TEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbText")
                                 (cons 1 context1)
                                 (cons 10 pmid)
                                 (cons 11 pmid)
                                 (cons 40 300) '(41 . 1.0)
                                 (cons 50 0.0) '(51 . 0.0)
                                '(71 . 0) '(72 . 1) '(73 . 2)
                         )
                )
          
             (setq i (1+ i))
         )
     )   
  )
  (command "_undo" "e")
  (princ)
)
回复 支持 反对

使用道具 举报

wzg356
发表于 2020-12-3 20:53:32 | 显示全部楼层
顺序一行一行的复制在命令行执行检查，我一般都这样
回复 支持 反对

使用道具 举报

yshf
发表于 2020-12-3 22:34:43 | 显示全部楼层
(defun c:zs ()
  (vl-load-com)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (if (setq ent (car (entsel "Select an LWPOLYLINE object:")))
      (progn
         (setq dxf (entget ent))
         (setq name (cdr (assoc 0 dxf)))
         (setq jdgs (cdr (assoc 90 dxf)))
         (if (and (= name "LWPOLYLINE") (= jdgs 4))
             (progn
                 (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) dxf)))
                 (setq pmid (mapcar '(lambda( a b)(* 0.5 (+ a b))) (car pts) (caddr pts)))
                 (setq area (/ (vlax-curve-getArea ent) 1000000.0))
                 (setq weight (* (* area 0.06) 2.5))
                 (setq context1 (strcat (rtos area) "平," (rtos weight) "t"))
                 (entmake (list
                                '(0 . "TEXT")
                                '(100 . "AcDbEntity")
                                '(100 . "AcDbText")
                                 (cons 1 context1)
                                 (cons 10 pmid)
                                 (cons 11 pmid)
                                 (cons 40 300) '(41 . 1.0)
                                 (cons 50 0.0) '(51 . 0.0)
                                '(71 . 0) '(72 . 1) '(73 . 2)
                         )
                )
             )
         )
      )
  )
  (princ)
)
回复 支持 反对

使用道具 举报

bai2000
发表于 2020-12-4 08:40:29 | 显示全部楼层
楼上的不错，能批量更好
回复 支持 反对

使用道具 举报

paulpipi
发表于 2020-12-4 10:18:27 来自手机 | 显示全部楼层
真好用，多谢分享*(╰╯)
回复 支持 反对

使用道具 举报

xvbzcmn
 楼主| 发表于 2020-12-4 13:02:56 | 显示全部楼层
多谢各位前辈指导~
回复 支持 反对

使用道具 举报

rocking2008
发表于 2020-12-5 22:05:20 | 显示全部楼层
(setq weight (* (* area 0.06) 2.5))
这个重量的计算，area是面积，乖以0.06是厚度，2.5是什么物质的1立方的重量？
回复 支持 反对

使用道具 举报

rocking2008
发表于 2020-12-5 22:12:23 | 显示全部楼层
yshf 发表于 2020-12-4 08:56
(defun c:plzs()
  (vl-load-com)
  (setvar "cmdecho" 0)

长老，能否加入圆、多边形、PL线画的封闭区域这3个对象。目前只能支持矩形。
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-17 07:02 , Processed in 0.204897 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表