标注文字填充色改成背景

zhuzhi1631

(defun c:tc () (textDimbackgroundfill) (princ))

(defun textDimbackgroundfill (/ ent)
  ;; codehimbelonga kdub@theSwamp 2008
    (while (setq ENT (KDUB:OBJSEL "Select Dimension or Text to set BackgroundFill to Masked"
                                  (list "DIMENSION" "MTEXT" "TEXT")
                                  nil
                     )
           )
        (if (= "DIMENSION" (cdr (assoc 0 (entget (car ent)))))
            (vla-put-textfill (vlax-ename->vla-object (car ent)) :vlax-true)
            ;; else
            (vla-put-backgroundfill (vlax-ename->vla-object (car ent))
                                    :vlax-true
            )
        )
    )
    (princ)
)
;;;---------------------------
;;;------------------------------------------------------------------
(defun kdub:objsel (promptmsg                ;
                    typelist                 ; List of entity types allowed to be selected
                    nentselflag              ; If true nentsel permitted , otherwise use entsel.
                    /            pickok       returnvalue
                    tmp
                   )
  ;; codehimbelonga kdub@theSwamp 2008
  (setq promptmsg (strcat "\n"
                          (cond (promptmsg)
                                ("Select object")
                          )
                          " : "
                  )
  )
  (while (not pickok)
    (setvar "ERRNO" 0)
    (setq returnvalue (if nentselflag
                        (nentsel promptmsg)
                        (entsel promptmsg)
                      )
    )
    (cond
      ((= (getvar "ERRNO") 52)               ; enter
       ;; skip out
       (setq pickok t)
      )
      ((= (getvar "ERRNO") 7)
       (princ "Nothing found at selectedpoint. ")
      )
      ((and
         (setq tmp (entget (car returnvalue))) ; object type
         typelist
         (not (member (cdr (assoc 0 tmp)) (mapcar 'strcase typelist)))
       )                                     ; wrong type
       (alert
         (strcat "Selected object is not"
                 "\na "
                 (apply 'strcat
                        (cons (car typelist)
                              (mapcar '(lambda (x) (strcat "\nor " x))
                                      (cdr typelist)
                              )
                        )
                 )
                 ". "
         )
       )
      )
      ;; skip out
      ((setq pickok t))
    )
  )
  returnvalue
)
;;

标注文字填充色改成背景色

HLCAD

程序不错，支持一下

zhuzhi1631

怎么就，没有大神给改一下呢