zhangcan0515 发表于 2020-10-2 13:17:33

求助：如何获取普通图块内直线与文字的组码

请问老师们如何获取普通图块内直线与文字的组码？

wzg356 发表于 2020-10-7 22:14:30

(defun c:tt8 ( / ss en x)
        (setq ss (ssget '((0 . "insert"))))
        (foreach en
                (vl-remove-if
                        '(lambda(x)(/= (type x) 'ENAME))
                        (mapcar 'cadr (ssnamex ss));栏选只要这句即可
                );图元名列表
                (setblk en)
        )
)
;修改块内文字、直线颜色(setblk)
(defun setblk (en / e)       
        (setq e (TBLOBJNAME "block" (cdr(assoc 2(entget en)))))
        (while(setq e (entnext e))
      (cond
                ((= (cdr(assoc 0(entget e))) "TEXT")
                        (setdxf e (cons 62 3));修改颜色为绿色
                )
                  ((= (cdr(assoc 0(entget e))) "LINE")
                 (setdxf e (cons 62 1));修改颜色为红色
                )
                (t nil)
          )
    )
    (entupd en);更新显示
)
;按新的点对表修改组码表更新图元
;(setdxf (car(entsel)) (cons 62 1))
(defun setdxf(en xin / enb)
        (if(assoc (car xin) (setq enb (entget en)))
           (entmod(subst xin (assoc (car xin) enb)enb))
           (entmod (cons xin enb))
        )
)

自贡黄明儒 发表于 2020-10-2 14:35:03

nentselnentselp

zhangcan0515 发表于 2020-10-7 20:49:01

wzg356 发表于 2020-10-7 20:26
;修改块内文字、直线颜色(setblk)
(defun setblk ( / en e)
      (setq en(car(entsel)));确保选块

谢谢老师，测试了一下，还有一点问题就是1不能批量2文字的颜色要变成绿色。我把自己找的源码给老师看看。祝近安！
(defun c:tt ()
(if (setq ssa (ssget '((0 . "insert")))) ;批量框选
      (progn
          (setq i 0)
          (setq n (sslength ssa))
          (repeat n
            (setq s1 (ssname ssa i))
            (foreach a (xyp-Block-OnameList (vlax-ename->vla-object s1))
                  (cond ((xyp-Etype (vlax-vla-object->ename a) "line")
                              (vla-put-color a 1);修改直线为红色
                        )
                        ((xyp-Etype (vlax-vla-object->ename a) "*text")
                              (vla-put-color a 3);修改文字为绿色
                     )
                  )
            )
            (setq i (1+ i))
          )
          (command "REGEN" )
      )
)
(princ)
)

wzg356 发表于 2020-10-2 21:13:05

(while (and(setq e (entnext e))
               (/= (cdr (assoc 0 (setq es (entget e)))) "SEQEND")
         )

e是块

zhangcan0515 发表于 2020-10-3 10:11:45

wzg356 发表于 2020-10-2 21:13
(while (and(setq e (entnext e))
               (/= (cdr (assoc 0 (setq es (entget e)))) "SEQEND") ...
已经收到我研究研究，有进展了在汇报上传源码，谢谢老师给予指导

zhangcan0515 发表于 2020-10-7 15:44:25

wzg356 发表于 2020-10-2 21:13
(while (and(setq e (entnext e))
               (/= (cdr (assoc 0 (setq es (entget e)))) "SEQEND") ...

组码是得到了，问题的得到的组码太多了，如何一个一个去替换那要替换到什么时候

wzg356 发表于 2020-10-7 16:11:36

zhangcan0515 发表于 2020-10-7 15:44
组码是得到了，问题的得到的组码太多了，如何一个一个去替换那要替换到什么时候

你到底要干啥，while循环着的

zhangcan0515 发表于 2020-10-7 16:13:58

wzg356 发表于 2020-10-7 16:11
你到底要干啥，while循环着的

得到普通块内部组码去修改块的颜色，因为块内有直线和文字

wzg356 发表于 2020-10-7 20:26:27

;修改块内文字、直线颜色(setblk)
(defun setblk ( / en e)
        (setq en(car(entsel)));确保选块
        (setq e (TBLOBJNAME "block" (cdr(assoc 2(entget en)))))
        (while(setq e (entnext e))
      (if(or (= (cdr(assoc 0(entget e))) "TEXT")
                         (= (cdr(assoc 0(entget e))) "LINE")
                     )
                 (setdxf e (cons 62 1));修改颜色为红色
          )
    )
    (entupd en);更新显示
)


;按新的点对表修改组码表更新图元
;(setdxf (car(entsel)) (cons 62 1))
(defun setdxf(en xin / enb)
        (if(assoc (car xin) (setq enb (entget en)))
           (entmod(subst xin (assoc (car xin) enb)enb))
           (entmod (cons xin enb))
        )
)

zhangcan0515 发表于 2020-10-7 20:56:32

获取普通图块内部信息组码，需要学习的可以拿走学习
(defun c:tt ()
        (setq ss (ssget (list '(0 . "INSERT"))))
        (getblockent ss))
;获取块内对象
(defun getblockent (ss / sslen ename enlast)
    (repeat (setq sslen (sslength ss))
      (setq ename (ssname ss (setq sslen (1- sslen))))
      (setq enlast (tblobjname "block" (cdr (assoc 2 (entget ename)))))
      (while (setq enlast (entnext enlast))
(princ (entget enlast))
      )
      )
(princ)
)
页: [1] 2
查看完整版本: 求助：如何获取普通图块内直线与文字的组码