附加扩展数据到ACAD实体.lsp

也许有用!

(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)
)