设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › Example Add Method
返回列表 发新帖
查看: 1780|回复: 4

[每日一码] Example Add Method

[复制链接]
st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2014-12-14 19:36:18 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
  1. (vl-load-com)
  2. (defun c:Example_Add()
  3.     ;; This example adds a block, dictionary, dimension style,
  4.     ;; group, layer, registered application, selection set,
  5.     ;; textstyle, view, viewport and UCS using the Add method.
  6.     (setq acadObj (vlax-get-acad-object))
  7.     (setq doc (vla-get-ActiveDocument acadObj))
  8.   
  9. ;; ADDBLOCK:
  10.     ;; Create a new block called "New_Block"

  12.     ;; Define the insertion point
  13.     (setq insertionPnt (vlax-3d-point 0 0 0))
  14.    
  15.     ;; Add the block to the blocks collection
  16.     (setq blocks (vla-get-Blocks doc))
  17.     (setq blockObj (vla-Add blocks insertionPnt "New_Block"))
  18.     (alert (strcat (vla-get-Name blockObj) " has been added."
  19.                     "\nOrigin: " (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 0) 2 2) ", "
  20.                                  (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 1) 2 2) ", "
  21.                                  (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin blockObj)) 2) 2 2)
  22.            )
  23.     )
  24.    
  25. ;; ADDDICTIONARY:
  26.     ;; Create a new dictionary called "New_Dictionary"

  28.     ;; Add the dictionary to the dictionaries collection
  29.     (setq dictionaries (vla-get-Dictionaries doc))
  30.     (setq dictObj (vla-Add dictionaries "New_Dictionary"))
  31.     (alert (strcat (vla-get-Name dictObj) " has been added."))

  33. ;; ADDDIMSTYLE:
  34.     ;; Create a new dimension style called "New_Dimstyle" in current drawing
  35.    
  36.     ;; Add the dimstyle to the dimstyles collection
  37.     (setq dimStyles (vla-get-DimStyles doc))
  38.     (setq dimStyleObj (vla-Add dimStyles "New_Dimstyle"))
  39.     (alert (strcat (vla-get-Name dimStyleObj) " has been added."))
  40.    
  41. ;; ADDGROUP:
  42.     ;; Create a new group called "New_Group" in current drawing
  43.    
  44.     ;; Add the group to the groups collection
  45.     (setq groups (vla-get-Groups doc))
  46.     (setq groupObj (vla-Add dimStyles "New_Group"))
  47.     (alert (strcat (vla-get-Name groupObj) " has been added."))
  48.    
  49. ;; ADDLAYER:
  50.     ;; This example creates a new layer called "New_Layer"
  51.    
  52.     ;; Add the layer to the layers collection
  53.     (setq layers (vla-get-Layers doc))
  54.     (setq layerObj (vla-Add layers "New_Layer"))
  55.    
  56.     ;; Make the new layer the active layer for the drawing
  57.     (vla-put-ActiveLayer doc layerObj)
  58.    
  59.     ;; Display the status of the new layer
  60.     (alert (strcat (vla-get-Name layerObj) " has been added."
  61.                    "\nLayerOn Status: " (if (= (vla-get-LayerOn layerObj) :vlax-true) "1" "0")
  62.                    "\nFreeze Status: " (if (= (vla-get-Freeze layerObj) :vlax-true) "1" "0")
  63.                    "\nLock Status: "  (if (= (vla-get-Lock layerObj) :vlax-true) "1" "0")
  64.                    "\nColor: " (itoa (vla-get-Color layerObj))
  65.            )
  66.     )
  67.    
  68. ;; ADDREGISTEREDAPP:
  69.     ;; Create a registered application named "New_RegApp" in current drawing
  70.    
  71.     ;; Add the registered application to the registered applications collection
  72.     (setq regApps (vla-get-RegisteredApplications doc))
  73.     (setq regAppObj (vla-Add regApps "New_RegApp"))
  74.     (alert (strcat (vla-get-Name regAppObj) " has been added."))

  76. ;; ADDSELECTIONSET:
  77.     ;; Create a selectionset named "New_SelectionSet" in current drawing
  78.    
  79.     ;; Add the selection set to the selection sets collection
  80.     (setq ssets (vla-get-SelectionSets doc))
  81.     (setq ssetObj (vla-Add ssets "New_SelectionSet"))
  82.     (alert (strcat (vla-get-Name ssetObj) " has been added."
  83.                     "\nThe number of items in the selection set is " (itoa (vla-get-Count ssetObj))
  84.            )
  85.     )
  86.    
  87. ;; ADDTEXTSTYLE:
  88.     ;; Create a textstyle named "New_Textstyle" in current drawing
  89.    
  90.     ;; Add the textstyle to the textstyles collection
  91.     (setq textStyles (vla-get-TextStyles doc))
  92.     (setq txtStyleObj (vla-Add textStyles "New_Textstyle"))
  93.     (alert (strcat (vla-get-Name txtStyleObj) " has been added."
  94.                     "\nHeight: " (rtos (vla-get-Height txtStyleObj) 2 2)
  95.                     "\nWidth: " (rtos (vla-get-Width txtStyleObj) 2 2)
  96.            )
  97.     )
  98.    
  99. ;; ADDVIEW:
  100.     ;; Create a view named "New_View" in current drawing
  101.    
  102.     ;; Add the view to the views collection
  103.     (setq views (vla-get-Views doc))
  104.     (setq viewObj (vla-Add views "New_View"))
  105.     (alert (strcat (vla-get-Name viewObj) " has been added."
  106.                     "\nHeight: " (rtos (vla-get-Height viewObj) 2 2)
  107.                     "\nWidth: " (rtos (vla-get-Width viewObj) 2 2)
  108.            )
  109.     )
  110.    
  111. ;; ADDVIEWPORT:
  112.     ;; Create a viewport named "New_Viewport" in current drawing
  113.    
  114.     ;; Add the viewport to the viewports collection
  115.     (setq viewports (vla-get-Viewports doc))
  116.     (setq vportObj (vla-Add viewports "New_Viewport"))
  117.     (alert (strcat (vla-get-Name vportObj) " has been added."
  118.                     "\nGridOn Status: " (if (= (vla-get-GridOn vportObj) :vlax-true) "1" "0")
  119.                     "\nOrthoOn Status: " (if (= (vla-get-OrthoOn vportObj) :vlax-true) "1" "0")
  120.                     "\nSnapOn Status: " (if (= (vla-get-SnapOn vportObj) :vlax-true) "1" "0")
  121.            )
  122.     )  
  123.    
  124. ;; ADDUCS:
  125.     ;; Create a UCS named "New_UCS" in current drawing
  126.   
  127.     ;; Define the UCS
  128.     (setq origin (vlax-3d-point 4 5 3)
  129.           xAxisPnt (vlax-3d-point 5 5 3)
  130.           yAxisPnt (vlax-3d-point 4 6 4))
  131.   
  132.     ;; Add the UCS to the UserCoordinatesSystems collection
  133.     (setq UCSs (vla-get-UserCoordinateSystems doc))
  134.     (setq ucsObj (vla-Add UCSs origin xAxisPnt yAxisPnt "New_UCS"))
  135.     (alert (strcat (vla-get-Name ucsObj) " has been added."
  136.                     "\nOrigin: " (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 0) 2 2) ", "
  137.                                  (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 1) 2 2) ", "
  138.                                  (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-Origin ucsObj)) 2) 2 2)
  139.            )
  140.     )  

  142. ;; ADDMATERIAL:
  143.     ;; Creates a material named "New_UCS" in the current drawing  
  144.     (setq oMaterials (vla-get-Materials doc))
  145.     (setq oMaterial (vla-Add oMaterials "TestMaterial"))
  146.     (vla-put-Description oMaterial "This example demonstrates how to add a material to a database.")
  147.     (vla-put-ActiveMaterial doc oMaterial)

  149.     ;; Display information about the material
  150.     (alert (strcat (vla-get-Name oMaterial) " has been added."
  151.                     "\nName: " (vla-get-Name oMaterial)
  152.                     "\nDescription: " (vla-get-Description oMaterial)
  153.            )
  154.     )
  155. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
发表于 2014-12-14 19:50:06 来自手机 | 显示全部楼层
向楼主学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

wzg356
发表于 2014-12-14 20:12:20 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
今天热闹，停不下来的节奏。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sicky111

已领礼包: 6468个

财富等级: 富甲天下
发表于 2014-12-25 17:47:38 | 显示全部楼层
第一个不用回复的每日一码。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xvjiex

已领礼包: 1094个

财富等级: 财源广进
发表于 2021-8-3 00:22:32 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
感谢楼主分享Example Add Method
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-10-28 10:32 , Processed in 0.368833 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表