论坛 › A/VLISP › 加入实体编码

yn1985321 发表于 2014-5-24 09:59:25

加入实体编码

无须下载，将源代码粘贴到写字板里，后缀改为LSP：
;;加入实体编码
(defun c:putstbm ()
(command "cmdecho" 0)
(setq errnum 0)
(setq zbmst (entsel "请选择主编码实体："))
(while (or (= zbmst nil)
   (= (assoc -3 (entget (car zbmst) (list "SOUTH"))) nil)
   (= (assoc 0 (entget (car zbmst) (list "SOUTH"))) "POINT")
)
    (setq zbmst (entsel "请重新选择主编码实体："))
)
(setq ss (entget (car zbmst) (list "SOUTH")))
(setq njcass (cdr (assoc -3 ss)))
(setq newstlx2 (car njcass))
(setq stlx (cdr (assoc 0 ss)))
(setq stltype (cdr (assoc 6 ss)))
(setq stlay (cdr (assoc 8 ss)))
(setq stlw 0.00)
(setq stthk (cdr (assoc 39 ss)))
(if (= stlx "LWPOLYLINE")
    (setq stlw (cdr (assoc 43 ss))
    )
)
(if (= stlx "POLYLINE")
    (setq stlw (cdr (assoc 40 ss))
    )
)
(if (= stlx "INSERT")
    (setq blkname (cdr (assoc 2 ss))
stlw   (cdr (assoc 41 ss))
stthk   (cdr (assoc 43 ss))
    )
)
(if (= stlx "TEXT")
    (setq textzg (cdr (assoc 40 ss))
textzt (cdr (assoc 7 ss))
textkd (cdr (assoc 41 ss))
textqx (cdr (assoc 51 ss))
stthk(cdr (assoc 39 ss))
    )
)
(if (= nil stthk)
    (setq stthk 0.0)
)
(princ "\n请选择需添加属性的实体:")
(setq q (ssget))
(if (/= nil q)
    (progn
      (setq qlen (sslength q))
      (setq l 0)
      (repeat qlen
(setq qqq (ssname q l))
(setq qq (entget (ssname q l) (list "SOUTH")))
(setq qstlx (cdr (assoc 0 qq)))
(setq qq (subst (cons 8 stlay) (assoc 8 qq) qq))
(if (and (/= stlx "TEXT") (/= qstlx "TEXT"))
(progn
    (if (and (= stlx "INSERT") (= qstlx "INSERT"))
      (progn
(setq qq (subst (cons 2 blkname) (assoc 2 qq) qq))
(setq qq (subst (cons 41 stlw) (assoc 41 qq) qq))
(setq qq (subst (cons 42 stlw) (assoc 42 qq) qq))
(setq qq (subst (cons 43 stthk) (assoc 43 qq) qq))
(if (/= nil (assoc -3 (entget qqq (list "SOUTH"))))
(setq qq (subst (cons -3 njcass) (assoc -3 qq) qq))
(progn
    (regapp "SOUTH")
    (setq
      qq (append qq (list (cons -3 (list newstlx2))))
    )
)
)
(entmod qq)
(entupd qqq)
      )
    )
    (if (and (/= stlx "INSERT")
   (/= qstlx "INSERT")
   (/= qstlx "POINT")
)
      (progn
(setq qq (subst (cons 6 stltype) (assoc 6 qq) qq))
(if (/= nil (assoc -3 (entget qqq (list "SOUTH"))))
(setq qq (subst (cons -3 njcass) (assoc -3 qq) qq))
(progn
    (regapp "SOUTH")
    (setq
      qq (append qq (list (cons -3 (list newstlx2))))
    )
)
)
(entmod qq)
(entupd qqq)
(command "change" qqq "" "p" "lw" stlw "")
(command "change" qqq "" "p" "T" stthk "")
      )
    )
    (if (or (and (= stlx "INSERT") (/= qstlx "INSERT"))
    (and (/= stlx "INSERT") (= qstlx "INSERT"))
    (= qstlx "POINT")
)
      (setq errnum (1+ errnum))
    )
)
)
(if (and (= stlx "TEXT") (= qstlx "TEXT"))
(progn
    (setq qq (subst (cons 40 textzg) (assoc 40 qq) qq))
    (setq qq (subst (cons 7 textzt) (assoc 7 qq) qq))
    (setq qq (subst (cons 41 textkd) (assoc 41 qq) qq))
    (setq qq (subst (cons 51 textqx) (assoc 51 qq) qq))
    (setq qq (subst (cons 39 stthk) (assoc 39 qq) qq))
    (if (/= nil (assoc -3 (entget qqq (list "SOUTH"))))
      (setq qq (subst (cons -3 njcass) (assoc -3 qq) qq))
      (progn
(regapp "SOUTH")
(setq
qq (append qq (list (cons -3 (list newstlx2))))
)
      )
    )
    (entmod qq)
    (entupd qqq)
)
)
(if (or (and (= stlx "TEXT") (/= qstlx "TEXT"))
(and (/= stlx "TEXT") (= qstlx "TEXT"))
    )
(setq errnum (1+ errnum))
)
(setq l (1+ l))
      )
    )
)
(if (/= errnum 0)
    (alert (strcat "\n共有"
   (itoa errnum)
   "个实体类型不匹配,未被添加属性!!"
   )
    )
)
)

xvjiex 发表于 2021-6-24 00:14:19

感谢分享加入实体编码！

ynpxqjlb 发表于 2023-1-12 10:40:54

学习一下···

qwangjun1994 发表于 2023-9-20 09:59:05

感谢分享,学习到了

happyending 发表于 2025-11-12 08:00:26

学到了，非常感谢您的分享。

dnbc 发表于 2025-11-12 08:33:10

回复学习一下{:1_12:}{:1_12:}{:1_12:}

查看完整版本: 加入实体编码