如何用vlisp新建多重引线样式

xpzzj

(vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE")
请问大佬们，用以上函数提取多重引线样式合集后用哪个函数可以在合集里添加一个样式名为“xp”的多重引线样式

liuhe

2. ;;;从AutoCAD 2013 Active Reference帮助中code Examples中提取  
   
3. ;;;本源代码由 xshrimp 2013.2.20 搜集整理,版权归原作者所有！  
   
4.   
   
5.   
   
6. (vl-load-com)  
   
7. (defun c:Example_MLeaderStyle()  
   
8.     (setq acadObj (vlax-get-acad-object))  
   
9.     (setq doc (vla-get-ActiveDocument acadObj))  
   
10.      
    
11.     (setq oDict (vla-Item (vla-get-Dictionaries doc) "ACAD_MLEADERSTYLE")  
    
12.           i 0)  
    
13.   
    
14.     (while (>= (1- (vla-get-Count oDict))  i)  
    
15.         (setq oObj (vla-Item oDict i))  
    
16.          
    
17.         (if (= (vla-get-ObjectName oObj) "AcDbMLeaderStyle")  
    
18.             (setq oMLS oObj)  
    
19.             
    
20.             (alert (strcat "Name = " (vla-get-Name oMLS)  
    
21.                            "\nAnnotative = " (if (= (vla-get-Annotative oMLS) :vlax-true) "True" "False")  
    
22.                            "\nContentType = " (itoa (vla-get-ContentType oMLS))  
    
23.                            "\nLeaderLineType = " (vla-get-Name (vla-get-LeaderLineType oMLS))))  
    
24.         )  
    
25.          
    
26.         (setq i (1+ i))  
    
27.     )  
    
28.      
    
29.     (setq oNewMLS (vla-AddObject oDict "TEST" "AcDbMLeaderStyle"))  
    
30.   
    
31.     (vla-put-LeaderLineType oNewMLS acSplineLeader)  
    
32.   
    
33.     (setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  
    
34.     (vla-put-ColorIndex oCol acBlue)  
    
35.     (vla-put-LeaderLineColor oNewMLS oCol)  
    
36.   
    
37.     (vla-SetVariable doc "CMLEADERSTYLE" "TEST")  
    
38.   
    
39.     (setq points (vlax-make-safearray vlax-vbDouble '(0 . 5)))  
    
40.     (vlax-safearray-fill points '(1 1 0  
    
41.                   2 2 0  
    
42.                  )  
    
43.     )  
    
44.     (setq i 0)  
    
45.      
    
46.     (setq modelSpace (vla-get-ModelSpace doc))  
    
47.     (setq oML (vla-AddMLeader modelSpace points i))  
    
48.     (vla-put-TextString oML "mleader created with \nstyle "TEST"")  
    
49.   
    
50.     (vlax-release-object oCol)  
    
51. )  
    

;;;从AutoCAD 2013 Active Reference帮助中code Examples中提取  <br /> ;;;本源代码由 xshrimp 2013.2.20 搜集整理,版权归原作者所有！  <br />   <br />   <br /> (vl-load-com)  <br /> (defun c:Example_MLeaderStyle()  <br />     (setq acadObj (vlax-get-acad-object))  <br />     (setq doc (vla-get-ActiveDocument acadObj))  <br />      <br />     (setq oDict (vla-Item (vla-get-Dictionaries doc) "ACAD_MLEADERSTYLE")  <br />           i 0)  <br />   <br />     (while (>= (1- (vla-get-Count oDict))  i)  <br />         (setq oObj (vla-Item oDict i))  <br />          <br />         (if (= (vla-get-ObjectName oObj) "AcDbMLeaderStyle")  <br />             (setq oMLS oObj)  <br />              <br />             (alert (strcat "Name = " (vla-get-Name oMLS)  <br />                            "\nAnnotative = " (if (= (vla-get-Annotative oMLS) :vlax-true) "True" "False")  <br />                            "\nContentType = " (itoa (vla-get-ContentType oMLS))  <br />                            "\nLeaderLineType = " (vla-get-Name (vla-get-LeaderLineType oMLS))))  <br />         )  <br />          <br />         (setq i (1+ i))  <br />     )  <br />      <br />     (setq oNewMLS (vla-AddObject oDict "TEST" "AcDbMLeaderStyle"))  <br />   <br />     (vla-put-LeaderLineType oNewMLS acSplineLeader)  <br />   <br />     (setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  <br />     (vla-put-ColorIndex oCol acBlue)  <br />     (vla-put-LeaderLineColor oNewMLS oCol)  <br />   <br />     (vla-SetVariable doc "CMLEADERSTYLE" "TEST")  <br />   <br />     (setq points (vlax-make-safearray vlax-vbDouble '(0 . 5)))  <br />     (vlax-safearray-fill points '(1 1 0  <br />                   2 2 0  <br />                  )  <br />     )  <br />     (setq i 0)  <br />      <br />     (setq modelSpace (vla-get-ModelSpace doc))  <br />     (setq oML (vla-AddMLeader modelSpace points i))  <br />     (vla-put-TextString oML "mleader created with \nstyle "TEST"")  <br />   <br />     (vlax-release-object oCol)  <br /> )  <br />

xpzzj

liuhe 发表于 2024-1-18 17:03
(setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  

这个19是对应cad版本，cad2024  就是24  ...

单位的电脑运行(setq NewmleaderstylesObj (vla-AddObject mleaderstylesObj "xp" "AcDbMLeaderStyle"))这行代码时提示错误

; 错误: Automation 错误。 系统注册表中不存在 AcRxClassName 项

liuhe

xpzzj 发表于 2024-1-18 14:19
(setq oNewMLS (vla-AddObject oDict "TEST" "AcDbMLeaderStyle"))
大佬，这个函数好像不对吧

(setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  

这个19是对应cad版本，cad2024  就是24  我这边测试没问题

xpzzj

(setq mleaderstylesobj (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) "ACAD_MLEADERSTYLE"))
(vla-addobject mleaderstylesobj "xp" "AcDbMLeaderStyle")
用这个函数返回nil

xpzzj

liuhe 发表于 2024-1-16 16:14

谢谢，我研究一下

天天问

http://bbs.mjtd.com/thread-188328-1-1.html
http://bbs.mjtd.com/thread-185240-1-1.html
多重引线，看我这个够用不够用

xpzzj

天天问 发表于 2024-1-17 13:39
http://bbs.mjtd.com/thread-188328-1-1.html
http://bbs.mjtd.com/thread-185240-1-1.html
多重引线，看 ...

你那个用的是DXF群码，改不了“箭头符号”样式，我想用VLA函数改“箭头符号”样式

xpzzj

liuhe 发表于 2024-1-16 16:14

(setq oNewMLS (vla-AddObject oDict "TEST" "AcDbMLeaderStyle"))
大佬，这个函数好像不对吧

xpzzj

liuhe 发表于 2024-1-18 17:03
(setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  

这个19是对应cad版本，cad2024  就是24  ...

奇怪，家里的电脑可以，明天我去单位再看看，谢谢！

xpzzj

liuhe 发表于 2024-1-18 17:03
(setq oCol (vlax-create-object "AutoCAD.AcCmColor.19"))  

这个19是对应cad版本，cad2024  就是24  ...

(setq oCol (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))