zjw1217 发表于 2020-5-30 08:39:49

自动套图框并将文本写入块

文字填写具有随机性，有朋友能帮助修改下吗？

(defun c:t3 ( / &kw ent ss1 sx x1 x2 y1 y2);自动套图框；多行文字填入指定块；支持判断横版图纸还是竖版图纸
        (setq pt1 (getpoint "-->请选取图框左下角点:\n"));getpoint 选取点
        (setq pt2 (getcorner pt1 "-->请选取图框右上角点:\n"));拾取对角点
        (if
                (setq &kw (ssget "w" pt1 pt2 )); "all"自动全选图内元素;套图框
                (progn
                        (setq ss1 '())
                        (while (setq ent (ssname &kw 0))(setq &kw (ssdel ent &kw) ss1 (cons ent ss1)));while
                        (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
                        (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))
                        (setq sx (vl-sort (mapcar 'car ss1) '<))
                        (setq x1 (car sx) x2 (last sx))
                        (setq sx (vl-sort (mapcar 'cadr ss1) '<))
                        (setq y1 (car sx) y2 (last sx))
                )
        )
        (princ)
        (setq bb (list x1 y1))
        (princ t)
        (setq disx (abs (- x2 x1)));取绝对值
        (setq disy (abs (- y2 y1)));car返回列表第二个元素
        ;(princ disx)
        (if (> disx disy)(setq acx(/ disx 420)));;判断是横版图纸还是竖版图纸
        (if (< disx disy)(setq acx(/ disx 210)))
        (if (> disx disy)(command "insert""A3"bb "X" acx "" "" "" "" ));用insert命令插入图框
        (if (> disy disx)(command "insert""A4S"bb "X" acx "" "" "" "" ));insert插入图框
        ;;;保存
; (if (and
   ;   (setq ss (ssget "w" pt1 pt2 ))
   ; )
   ; (progn
    ;(setq len (sslength ss)
    ;      i 0
   ; )
   ; (repeat len
   ;   (setq e (ssname ss i))
   ;   (setq ed (entget e))
      ;(setq old (assoc 48 ed))
      ;(setq new (cons 48 acx))
      ;(if old
      ;    (setq ed (subst new old ed))
      ;    (setq ed (cons new ed))
      ;)
       ; (entmod ed)
       ; (setq i (1+ i))
   ; )
   ; )
;)
;将文本写入块，图框点选未能自动选择
;显示出选中的所有单行文字
    (setq myxz (ssget "w" pt1 pt2 '((0 . "text,MTEXT"))))   ;获取仅有单行文字的选择集 "w" pt1 pt2 窗口选择
    (setq wenzishu (sslength myxz));获取选择集中图元的个数S
    (setq i 0)
        (setq j 0)
    (while (< j wenzishu)
      (setq tuyuanhao (ssname myxz i))   ;获取图元号
      (setq wenzi_str (cdr (assoc 1 (entget tuyuanhao))))
      ;entget 返回图元属性列表
      ;assoc 返回单行文字的内容，为一点对，（1."字符串"）
      ;cdr 去除点对第一个元素
      (print wenzi_str);输出文字
;********************************写属性块
                (defun attchg (ent attname new / EN ENTLIST)
                (defun MJ:DXF (IT LST)(cdr (assoc IT LST)))
                (if (and (setq en ent)
                        (setq entlist (entget en))
                        (equal (MJ:DXF 0 entlist) "INSERT")
                        (equal (MJ:DXF 66 entlist) 1) ;=1则块有属性值
                        )
                        (while
                                (and en(setq en (entnext en))(setq entlist (entget en))(equal (MJ:DXF 0 entlist) "ATTRIB"))
                                (if
                                        (= (strcase (MJ:DXF 2 entlist)) (strcase attname))
                                        (progn
                                                (entmod (subst (cons 1 new) (assoc 1 entlist) entlist))
                                                (entupd ent)
                                                (setq en nil)
                                        )
                                )
                        )
                )
                (princ)
                )       
                ;此处更改判断，将文本填入属性块       
                (if (= j 0)(attchg (ssname (ssget "l") 0) "材料规格" wenzi_str ))               
                (if (= j 1)(attchg (ssname (ssget "l") 0) "数量" wenzi_str ))               
                (if (= j 2)(attchg (ssname (ssget "l") 0) "比例" wenzi_str ))
                (if (= j 3)(attchg (ssname (ssget "l") 0) "图样代号" wenzi_str ))
                (if (= j 3)(attchg (ssname (ssget "l") 0) "图样代号." wenzi_str ));此处更改判断，将文本填入属性块
                (if (= j 4)(attchg (ssname (ssget "l") 0) "图样名称" wenzi_str ))               
                (if (= j 5)(attchg (ssname (ssget "l") 0) "材料名称" wenzi_str ));
;********************************               
                (setq j (+ 1 j))
        )   
)

(defun x1903211 (obj / obj x3 y3);tes子函数
        (vla-getboundingbox obj 'x3 'y3)
        (mapcar 'vlax-safearray->list (list x3 y3));点表
)
(setq *en2obj* vlax-ename->vla-object)

zjw1217 发表于 2020-5-30 08:40:36

我怀疑是在判断上和图元获取方面出了问题

hnzkhyyl 发表于 2020-10-24 08:26:34

进来看看，试试效果怎么样

xiaozhu33033 发表于 2021-1-13 14:06:41

本帖最后由 xiaozhu33033 于 2022-7-10 01:21 编辑

谢谢分享！！！！！！！！！！

season_88 发表于 前天 21:16

学习大师源码
页: [1]
查看完整版本: 自动套图框并将文本写入块