yangchao2005090 发表于 2020-5-21 16:08:38

win10cad2014下下列代码有问题，有人能帮忙改一下么

(defun C:tt (/      aDoc mSpace Blocks Block Obj Count Name      i Text ColHat
            Color LType)
(setq      aDoc   (vla-get-ActiveDocument (vlax-get-acad-object))
      mSpace (vla-get-ModelSpace aDoc)
      Blocks (vla-get-Blocks aDoc)
      Color256 ;ByLayer-256ByBlock-0
      ColHat 8
      LType"ByLayer"
      Count(vla-get-Count Blocks)
      i      0
)
(vlax-for Block Blocks
    (setq i    (1+ i)
          Text (strcat "正在处理<块定义>：" (itoa i) "/" (itoa Count))
    )
    (grtext -1 Text)
    (vlax-for Obj Block
      (setq Name (vla-get-ObjectName Obj))
      (setq tb obj)
      (cond
      ((= Name "AcDbBlockReference")) ;不改变
      ((wcmatch Name "TDb*")) ;天正对象不改变
      ((= Name "AcDbHatch") (vla-put-Color Obj ColHat))
      (T (vla-put-Color Obj Color))
      ) ;cond
      (vla-put-Linetype Obj LType)
    ) ;vlax-for
)
(setq      Count (vla-get-Count mSpace)
      i   0
)
(vlax-for Obj      mSpace
    (setq i    (1+ i)
          Text (strcat "正在处理<图元>：" (itoa i) "/" (itoa Count))
    )
    (grtext -1 Text)
    (setq Name (vla-get-ObjectName Obj))
    (cond
      ((= Name "TDbDimension2")) ;不改变
      ((= Name "AcDbBlockReference")) ;不改变
      ((wcmatch Name "TDb*")) ;天正对象不改变
      ((= Name "AcDbHatch") (vla-put-Color Obj ColHat))
      (T (vla-put-Color Obj Color))
    ) ;cond
    (vla-put-Linetype Obj LType)
) ;vlax-for
(grtext)
(princ "\n修改全部图元和块定义内对象颜色和线型随层（填充可单独指定）完成")
(princ)
)

yangchao2005090 发表于 2020-5-21 16:08:57

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=95817&highlight=%BF%E9%2B%D1%D5%C9%AB

烟盒迷唇 发表于 2020-5-21 17:00:15

天正的，不知道要改什么
页: [1]
查看完整版本: win10cad2014下下列代码有问题，有人能帮忙改一下么