社区 › 编程申请 › 编写程序按图层进行替换线型及字体。

rrrr1111 发表于 2004-11-14 21:59:00

编写程序按图层进行替换线型及字体。

各位高手,请给予帮助。我是一个新手，想利用编程来完成按图层进行替换线型及字体，每层中的文字或线形都可以按程序中事先约定好的字体或线形来替换（如第一层所有的线用点划线，第二层中所有的线用铁路线等等），望高手不吝赐教，谢谢。

龙龙仔 发表于 2004-11-16 14:21:00

;;需先建立线型及字体!
;;By 龙龙仔(LUCAS)
;;不支持属性(自已加入吧!)
;;(CH_LW <layer><linetype><textstyle>)
;;(CH_LW "0" "CENTER" "细明体")
;;(CH_LW "0" "CENTER" ""); "" 不改变
(defun CH_LW (LAYERNAME LINETYPE STYLENAME / BLKS ENT ENTT)
   (vl-load-com)
   (vlax-for ENT(vla-get-blocks
       (vla-get-activedocument (vlax-get-acad-object))
    )
       (vlax-for ENTT ENT
         (if (= (strcase (vla-get-layer ENTT)) (strcase LAYERNAME))
(progn
   (if (/= LINETYPE "")
         (vl-catch-all-apply
             'vla-put-linetype
             (list ENTT LINETYPE)
         )
   )
   (if (/= STYLENAME "")
         (vl-catch-all-apply
             'vla-put-stylename
             (list ENTT STYLENAME)
         )
   )
)
         )
       )
   )
   (princ)
)

查看完整版本: 编写程序按图层进行替换线型及字体。