乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: ordengate

[编程交流] 将块属性插入te

[复制链接]

3

主题

14

帖子

11

银币

初来乍到

Rank: 1

铜币
15
发表于 2022-7-6 11:28:08 | 显示全部楼层
Finished product for anyone interested.  Thanks again for the help.
  1. (vl-load-com)(DEFUN C:TID ()(SETQ V:JUST "TL")(SETQ        V:JUST (GETSTRING "Justification: (TL,TC,TR,ML,MC,MR,BL,BC,BR) : "))(IF (OR (= "TL" V:JUST)        (= "tl" V:JUST)        (= "" V:JUST))        (INSIDTL)        (PRINC))(IF (OR (= "TC" V:JUST)        (= "tc" V:JUST))                                                                (INSIDTC)        (PRINC))(IF (OR (= "TR" V:JUST)        (= "tr" V:JUST))                                                                (INSIDTR)        (PRINC))(IF (OR (= "ML" V:JUST)        (= "ml" V:JUST))                                                                (INSIDML)        (PRINC))(IF (OR (= "MC" V:JUST)        (= "mc" V:JUST))                                                                (INSIDMC)        (PRINC))(IF (OR (= "MR" V:JUST)        (= "mr" V:JUST))                                                                (INSIDMR)        (PRINC))(IF (OR (= "BL" V:JUST)        (= "bl" V:JUST))                                                                (INSIDBL)        (PRINC))(IF (OR (= "BC" V:JUST)        (= "bc" V:JUST))                                                                (INSIDBC)        (PRINC))(IF (OR (= "BR" V:JUST)        (= "br" V:JUST))                                                                (INSIDBR)        (PRINC)))(DEFUN C:TCIRC ()(SETQ V:JUST "TL")(SETQ        V:JUST (GETSTRING "Justification: (TL,TC,TR,ML,MC,MR,BL,BC,BR) : "))(IF (OR (= "TL" V:JUST)        (= "tl" V:JUST)        (= "" V:JUST))        (INSCIRCTL)        (PRINC))(IF (OR (= "TC" V:JUST)        (= "tc" V:JUST))                                                                (INSCIRCTC)        (PRINC))(IF (OR (= "TR" V:JUST)        (= "tr" V:JUST))                                                                (INSCIRCTR)        (PRINC))(IF (OR (= "ML" V:JUST)        (= "ml" V:JUST))                                                                (INSCIRCML)        (PRINC))(IF (OR (= "MC" V:JUST)        (= "mc" V:JUST))                                                                (INSCIRCMC)        (PRINC))(IF (OR (= "MR" V:JUST)        (= "mr" V:JUST))                                                                (INSCIRCMR)        (PRINC))(IF (OR (= "BL" V:JUST)        (= "bl" V:JUST))                                                                (INSCIRCBL)        (PRINC))(IF (OR (= "BC" V:JUST)        (= "bc" V:JUST))                                                                (INSCIRCBC)        (PRINC))(IF (OR (= "BR" V:JUST)        (= "br" V:JUST))                                                                (INSCIRCBR)        (PRINC)));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;(defun INSIDTL(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointTopLeft)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDTC(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointTopCenter)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDTR(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointTopRight)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDML(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleLeft)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDMC(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleCenter)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDMR(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointMiddleRight)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDBL(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointBottomLeft)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDBC(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointBottomCenter)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ))(defun INSIDBR(/ acsp atts blk_obj ent found id pt tag)(while (setq ent (entsel "\nSelect block instance (or press Enter to Exit): "))        (setq blk_obj (vlax-ename->vla-object (car ent)))        (Setq tag "ID")        (if (eq (chr 0) tag)        (setq tag "ID"))        (setq atts (vlax-invoke blk_obj 'getattributes))        (foreach att atts                (if (eq (vla-get-tagstring att) tag)                        (progn                                (setq found (vla-get-textstring att))                                (setq id (vla-get-objectid att))                                (setq pt (getpoint "\nPick a  field location: "))                                (setq acsp (vla-get-block                                        (vla-get-activelayout                                        (vla-get-activedocument                                        (vlax-get-acad-object))))                                )                                (setq mtxtobj (vlax-invoke-method acsp 'addmtext (vlax-3d-point pt) 0.0                                        (strcat  "%%"))                                )                                (vla-put-attachmentpoint mtxtobj acAttachmentPointBottomRight)                                (vla-put-insertionpoint mtxtobj (vlax-3d-point pt))                        )                )        ))(princ));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-6 21:59 , Processed in 0.361876 second(s), 52 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表