(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 afield 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 afield 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 afield 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 afield 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 afield 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 afield 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 afield 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 afield 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 afield 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));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
页:
1
[2]