AutoCAD实体添加和读取扩展信息的AutoLISP函数

最新推荐文章于 2023-08-15 00:42:53 发布

测量老覃

最新推荐文章于 2023-08-15 00:42:53 发布

阅读量2.9k

点赞数

分类专栏： # AutoLISP 文章标签：扩展信息

本文链接：https://blog.csdn.net/hjpqindong/article/details/91385226

版权

AutoLISP 专栏收录该内容

33 篇文章

订阅专栏

本文分享了两个用于AutoCAD实体的Lisp函数，分别用于添加和读取扩展信息。通过这些函数，可以将横断面参数以扩展信息形式附加到多义线，便于后续处理时识别和提取数据。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

这是以前编写断面绘图程序时写的两个函数，一是给AutoCAD实体（可见对象）添加扩展信息的代码，另一个是从实体读取扩展信息的代码。本意是用此程序绘出的断面线在绘图时将该横断面的参数以扩展信息添加到多义线上，后续处理时可判断断面线是否是程序所绘并从断面线上提取断面线所在横断面的参数，如断面基准点坐标信息等。

一、给AutoCAD实体添加扩展信息的函数代码：

(defun AddXdata()
(if (/= sa nil)(setq DwgX (rtos sa 2 7))(setq DwgX "z"))
(if (/= sb nil)(setq DwgY (rtos sb 2 7))(setq DwgY "z"))
(setq OrivX (car Oriv))
(setq OrivY (cadr Oriv))
(if (/= OrivX nil)(setq ProX (rtos OrivX 2 3))(setq ProX "z"))
(if (/= OrivY nil)(setq ProY (rtos OrivY 2 3))(setq ProY "z"))


(setq Selection (ssget))

(setq ExtData (getstring "请输入扩展信息："))
(setq Info ExtData)
(setq IndexB 0)
 (if (and (/= Selection nil) (/= ExtData ""))(progn
      (setq NumSelected (sslength Selection))
  (repeat NumSelected
(setq ExtData (strcat "*" DwgX "*" DwgY "*" ProX "*" ProY "*" Info "*"))
      (setq ET (ssname Selection IndexB))
      (setq IndexB (+ IndexB 1))
      (setq lastent (entget ET))
      (setq EntType (cdr (assoc '0 lastent))) 
      (if (= EntType "LINE")(progn
            (setq StartPx (cadr (assoc '10 lastent)))
            (setq StartPy (caddr (assoc '10 lastent)))
            (setq EndPx (cadr (assoc '11 lastent)))
            (setq EndPy (caddr (assoc '11 lastent)))
(setq ExtData (strcat ExtData  (rtos StartPx 2 7) "*" (rtos StartPy 2 7) "*" (rtos EndPx 2 7) "*" (rtos EndPy 2 7)))
                            );end progn
      );end if 
  
      (setq Lst (list -3 (list "NEWDATA" (cons 1000 ExtData))))
      (regapp "NEWDATA")
      (setq exdata lst)
      (setq newent
      (list (car lastent) exdata))
      (entmod newent)
(setq ExtData "")
  );end repeat
                                                );end progn
 );end if


(princ)
)

二、读取AutoCAD实体扩展信息的代码：

(defun ReadXdata()
(setq PositionInStr 2)
(Setq DWX "" DWY "" PRX "" PRY "" XDTA "" SX "" SY "" EX "" EY "") 
(setq Str (cdr (cadr (cadr (assoc '-3 (entget (car (entsel)) '("NEWDATA")))))))
(if (/= str nil)(progn
(setq StrLength (strlen str)) 

(if (< PositionInStr StrLength)(progn 
(while (/= (setq Ch (substr str PositionInStr 1)) "*")
(setq DWX (strcat DWX ch))
(setq PositionInStr (+ PositionInStr 1))
))) 


(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq DWY (strcat DWY ch))
(setq PositionInStr (+ PositionInStr 1))
)))


(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq PRX (strcat PRX ch))
(setq PositionInStr (+ PositionInStr 1))
)))


(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn  
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq PRY (strcat PRY ch))
(setq PositionInStr (+ PositionInStr 1))
) ))


(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq XDTA (strcat XDTA ch))
(setq PositionInStr (+ PositionInStr 1))
))) 

(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq SX (strcat SX ch))
(setq PositionInStr (+ PositionInStr 1))
))) 

(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq SY (strcat SY ch))
(setq PositionInStr (+ PositionInStr 1))
))) 

(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq EX (strcat EX ch))
(setq PositionInStr (+ PositionInStr 1))
))) 

(setq PositionInStr (+ PositionInStr 1))
(if (< PositionInStr StrLength)(progn 
(while (and (/= (setq Ch (substr str PositionInStr 1)) "*") (< PositionInStr StrLength))
(setq EY (strcat EY ch))
(setq PositionInStr (+ PositionInStr 1))
))) 

(if (and (/= SX "") (/= SY ""))(progn

(setq sTmx (atof SX))
(setq sTmy (atof SY))

(setq eTmx (atof EX))
(setq eTmy (atof EY))

(setq SX (rtos (+ (- sTmx (atof DWX)) (atof PRX)) 2 3))
(setq SY (rtos (+ (- sTmy (atof DWY)) (atof PRY)) 2 3))

(setq EX (rtos (+ (- eTmx (atof DWX)) (atof PRX)) 2 3))
(setq EY (rtos (+ (- eTmy (atof DWY)) (atof PRY)) 2 3))

                               )
)

(if (= SX "") (setq SX "Not a line"))
(if (= EX "") (setq EX "Not a line"))
(if (or (= DWX "") (= DWX "z")) (progn (setq DWX "No origin setlecting")(setq DWY "")))
(if (or (= PRX "") (= PRX "z")) (progn (setq PRX "No origin setting") (setq PRY "")))
(if (= XDTA "")(setq XDTA "No Xdata"))


(alert (strcat "断面原点: " DWX "  " DWY "\n原点设为: " PRX "    " PRY "\n\n直线起点: " SX " " SY "\n直线终点: " EX " " EY "\n\n信    息: " XDTA ))(princ)
)(progn (alert "该实体没有扩展信息!")(princ))
)
)