修改块属性.lsp

分类:lisp函数 | 标签: 修改     属性  
2012-07-24 08:20 阅读(?)评论(0)

修改块属性.lsp


;;;=============================================*
;;;测试                                         *
;;;                                             *
(defun C:TT (/ SS)
  (if (and
	(princ "\n点取要修改的属性块...")
	(setq SS (ssget '((0 . "INSERT"))))
	(setq i 0)
      )
    (repeat (sslength ss)
      (setq en (ssname ss i))
      ;;修改样式、字高、高宽比
      (foreach name (ZL-INSERT-gETATTallname en)
	(ZL-INSERT-SETATT en name 7 "TWYZY")
	(ZL-INSERT-SETATT en name 40 0.5)
	(ZL-INSERT-SETATT en name 41 0.7)
	(ZL-INSERT-SETATT en name 62 1)
      )
      (setq i (1+ i))
    )
  )
  (princ)
)
;;;=============================================*

;;;=================================================================*
;;;      通用函数                                                   *
;;;功能:属性块中属性文字的修改                                     *
;;;参数:     EN -----包含属性的块的图元名称                        *
;;;      AttName -----属性名称                                      *
;;;          int -----修改的组码编号                                *
;;;        Value -----修改为的值                                    *
;;;返回:T表示修改成功;否则返回nil                                 *
;;;日期:zml84 于 2012-07-23                                        *
(defun ZL-INSERT-SETATT	(EN ATTNAME int VALUE / RETURN E TEST ENT)
  (setq	E EN
	RETURN NIL
	TEST t
  )
  (while (and TEST
	      (setq E (entnext E))
	 )
    (setq ENT (entget E))
    (cond
      ;;
      ((not (= (cdr (assoc 0 ENT)) "ATTRIB"))
       (setq TEST NIL)
      )
      ;;
      ((= "SEQEND" (cdr (assoc 0 ENT)))
       (setq TEST NIL)
      )
      ;;
      ((= (cdr (assoc 2 ENT)) ATTNAME)
       (if (assoc INT ENT)
	 (setq ENT (subst
		     (cons INT VALUE)
		     (assoc INT ENT)
		     ENT
		   )
	 )
	 (setq ENT (cons
		     (cons INT VALUE)
		     ENT
		   )
	 )
       )
       (entmod ENT)
       (entupd EN)
       (setq RETURN t)
      )
    ) ;_结束cond
  )
  ;;返回
  RETURN
)
;;;=================================
(defun ZL-INSERT-gETATTallname (EN / RETURN E TEST ENT lst name)
  (setq	lst '()
	E EN
	RETURN NIL
	TEST t
  )
  (while (and TEST
	      (setq E (entnext E))
	 )
    (setq ENT (entget E))
    (cond
      ;;
      ((not (= (cdr (assoc 0 ENT)) "ATTRIB"))
       (setq TEST NIL)
      )
      ;;
      ((= "SEQEND" (cdr (assoc 0 ENT)))
       (setq TEST NIL)
      )
      ;;
      (t
       (setq name (cdr (assoc 2 ENT))
	     lst  (cons name lst)
       )
       (setq RETURN t)
      )
    ) ;_结束cond
  )
  ;;返回
  lst
)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明