原创VLISP中创建文字样式和图层源程序

tcsl9621

(vl-load-com)

(setq p2c::acadobj (vlax-get-acad-object)
      p2c::acaddocobj (vla-get-activedocument p2c::acadobj)
      p2c::mspaceobj (vla-get-modelspace p2c::acaddocobj)
      p2c::pspaceobj (vla-get-paperspace p2c::acaddocobj)
      p2c::docobj (vla-get-documents p2c::acadobj)
      p2c::blocksobj (vla-get-blocks p2c::acaddocobj)
      p2c::layersobj (vla-get-layers p2c::acaddocobj)
      p2c::textstyles (vla-get-Textstyles p2c::acaddocobj)
      p2c::linetypes (vla-get-linetypes p2c::acaddocobj)
      p2c::menugroupsel (vla-get-menugroups p2c::acadobj)
      p2c::menugroup (vla-item p2c::menugroupsel 0)
      p2c::menuobj (vla-get-menus p2c::menugroup)
      p2c::toolbars (vla-get-toolbars p2c::menugroup)
)

;;;============
;;;= 设置图层 =
;;;============

.(defun addtranslayer (/      styleobj1   layerobj1
        layerobj2     layerobj3   layerobj4
        layerobj5     layerobj6   layerobj7
        layerobj8     layerobj9   layerobj10
       )
  (vl-catch-all-apply
    'vla-load
    (list p2c::linetypes
   "center"
   "acadiso.lin"
    )
  )
  (vl-catch-all-apply
    'vla-load
    (list p2c::linetypes
   "DASHED"
   "acadiso.lin"
    )
  )
  (setq styleobj1 (vla-add p2c::textstyles "GB"))
  (vla-put-fontfile styleobj1 "gbenor.shx")
  (vla-put-bigfontfile styleobj1 "gbcbig.shx")
  (setq layerobj1  (vla-add p2c::layersobj "KERFLEFT")
 layerobj2  (vla-add p2c::layersobj "KERFRIGHT")
 layerobj3  (vla-add p2c::layersobj "KERFOFF")
 layerobj4  (vla-add p2c::layersobj "MARKING")
 layerobj5  (vla-add p2c::layersobj "PLATE")
 layerobj6  (vla-add p2c::layersobj "ZSQ")
 layerobj7  (vla-add p2c::layersobj "CENTER")
 layerobj8  (vla-add p2c::layersobj "DASHED")
;;;
 layerobj9  (vla-add p2c::layersobj "INSIDE")
 layerobj10 (vla-add p2c::layersobj "OUTSIDE")
  )
;;;KERFLEFT
  (vla-put-color layerobj1 acred)
  (vla-put-lineweight layerobj1 aclnwt025)
  (vla-put-linetype layerobj1 "continuous")
;;;KERFRIGHT
  (vla-put-color layerobj2 acred)
  (vla-put-lineweight layerobj2 aclnwt025)
  (vla-put-linetype layerobj2 "continuous")
;;;KERFNO
  (vla-put-color layerobj3 acred)
  (vla-put-lineweight layerobj2 aclnwt025)
  (vla-put-linetype layerobj3 "continuous")
;;;MARKING
  (vla-put-color layerobj4 accyan)
  (vla-put-lineweight layerobj4 aclnwt025)
  (vla-put-linetype layerobj4 "continuous")
;;LATE
  (vla-put-color layerobj5 acblue)
  (vla-put-lineweight layerobj2 aclnwt030)
  (vla-put-linetype layerobj5 "continuous")
;;;ZSQ
  (vla-put-color layerobj6 acwhite)
  (vla-put-linetype layerobj6 "continuous")
;;;CENTER
  (vla-put-color layerobj7 acred)
  (vla-put-linetype layerobj7 "CENTER")
;;;DASHED
  (vla-put-color layerobj8 acgreen)
  (vla-put-linetype layerobj8 "DASHED")
;;;INSIDE
  (vla-put-color layerobj9 acgreen)
  (vla-put-lineweight layerobj9 aclnwt025)
  (vla-put-linetype layerobj9 "continuous")
;;;OUTSIDE
  (vla-put-color layerobj10 acred)
  (vla-put-lineweight layerobj10 aclnwt025)
  (vla-put-linetype layerobj10 "continuous")
;;;END
  (princ)
)

红色为后加代码。不加程序没法运行。

tcsl9621

顶回来，再错过。可就没有了。我也不再顶了。再无人问迳就删除源代码。呵……

lxwlxwaayf

看看

rongyifei

有这么的热心的大哥,真的太幸运了!

rongyifei

 不过运行不了!

出现下面的提示:

error: bad argument type: VLA-OBJECT nil

我看不明白:

程序中的p2c::textstyles,p2c::linetypes,p2c::layersobj等都没有定义,

程序能正常运行吗?还望指点!!!

tcsl9621

程序前加这些:

(vl-load-com)

(setq p2c::acadobj (vlax-get-acad-object)
      p2c::acaddocobj (vla-get-activedocument p2c::acadobj)
      p2c::mspaceobj (vla-get-modelspace p2c::acaddocobj)
      p2c::pspaceobj (vla-get-paperspace p2c::acaddocobj)
      p2c::docobj (vla-get-documents p2c::acadobj)
      p2c::blocksobj (vla-get-blocks p2c::acaddocobj)
      p2c::layersobj (vla-get-layers p2c::acaddocobj)
      p2c::textstyles (vla-get-Textstyles p2c::acaddocobj)
      p2c::linetypes (vla-get-linetypes p2c::acaddocobj)
      p2c::menugroupsel (vla-get-menugroups p2c::acadobj)
      p2c::menugroup (vla-item p2c::menugroupsel 0)
      p2c::menuobj (vla-get-menus p2c::menugroup)
      p2c::toolbars (vla-get-toolbars p2c::menugroup)
)

就好了.

rongyifei

多谢!

tcsl9621

这是我编的程序中的一部分。现在这已是我所有程序都用的成熟代码。

qianglcq

多谢版主分享

li_abcxyz

谢谢，获益匪浅呢