设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 行业篇 › AutoCAD与GIS测绘 › 修改仓老师代码，不开图批量拟合二维多段线等高线
返回列表 发新帖
查看: 1892|回复: 9

修改仓老师代码，不开图批量拟合二维多段线等高线

[复制链接]
树櫴希德
发表于 2023-6-21 22:06:13 | 显示全部楼层 |阅读模式
修改仓老师代码，不开图批量拟合二维多段线等高线
  1. ;(assoc 0(entget(car(entsel))'("*")) )

  3. (defun try-getFolder (msg / WinShell shFolder path catchit)
  4. (setq winshell (vlax-create-object "Shell.Application"))
  5. (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  6. (setq catchit (vl-catch-all-apply
  7.            '(lambda ()
  8.              (setq shFolder (vlax-get-property shFolder 'self))
  9.              (setq path (vlax-get-property shFolder 'path))
  10.             )
  11.           )
  12. )
  13. (if (vl-catch-all-error-p catchit)
  14.   nil
  15.   path
  16. )
  17. )

  19. (defun c:plind123 (/ BANBEN DBX PATH FILES DH STR PT0 PT1 I DWGNAME temp ob obj)
  20.   (vl-load-com)
  21. ;(setvar "cmdecho" 0)
  22.   (initget 1 "D S F 3S")    (setq temp (getkword "(D)不拟合/(S)2次样条拟合/(3S)3次样条拟合/(F)圆弧拟合] <F>"))
  23.   (setq banben (substr (getvar "acadver") 1 2))
  24.   ;版本2004-2006返回16,2007-2009返回17,2010-2012返回18,2013返回19
  25.   (setq dbx (Vlax-Get-Or-Create-Object (strcat "ObjectDBX.AxDbDocument." banben)))
  26.   (setq path (strcat (try-getFolder "\n 选择图纸所在文件夹名称：") "\\"));文件夹路径
  27.   (setq files (vl-directory-files path "*.dwg" 1)) ;获取所有文件名
  28.   
  29.   (setq i -1)
  30.   (while (setq dwgname (nth (setq i (1+ i)) files))
  31.     (vlax-invoke-method dbx 'open (strcat path dwgname))
  32.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33.     (vlax-for ob (Vlax-Get dbx 'ModelSpace) ;历遍模型空间集合;;;;;;;;;;;;;;;;;;;;;;;;
  34.   ; (vlax-3d-point '(100 100 100))
  35. (cond  ((equal (type ob) 'ENAME) (setq obj (vlax-ename->vla-object ob)))
  36.   (T (setq obj ob))  )

  38.       
  39. (if  (and   (= (vla-get-Layer Obj) "DGX" )  (= (vlax-get-property obj 'ObjectName) "AcDb2dPolyline")   )

  41.    (progn   

  43. (cond

  45.     ((= temp "D")   (vla-put-Type obj  0) (vla-Update obj )   )

  47.     ((= temp "F")   (vla-put-Type obj  1) (vla-Update obj ))

  49.     ((= temp "S")   (vla-put-Type obj  2) (vla-Update obj ))

  51.     ((= temp "3S")   (vla-put-Type obj  3) (vla-Update obj ))

  53.   )


  56.      )


  59.   )

  61.       

  63.       ;(vla-move ob (vlax-3d-point pt0)(vlax-3d-point pt1))
  64.     );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  66.    
  67.     (vlax-invoke-method dbx 'SaveAs (strcat path dwgname))
  68.   )  ;;;;;;;;;;;;;;;;;;;;;;;;
  69.   (vlax-release-object dbx);释放
  70.   ;(setvar "cmdecho" 1)
  71.   (princ)
  72. )
  73. ;(princ "\n 不开图地形图平移代号坐标运行命令：pydhzb")
  74. ;(princ "\n 如有疑问或者好的建议请联系老仓测绘上班记QQ:729292370")
  75. (princ)

  77. ;(vlax-get-property (vlax-ename->vla-object (car(entsel))) 'ObjectName)

  79. ;;(vla-get-Layer (vlax-ename->vla-object (car(entsel))))
  80. ;(vlax-get-property (vlax-ename->vla-object (car(entsel))) ''EntityType)

  82. ;(vl-cmdf "CONVERTPOLY" "h" (vlax-vla-object->ename (vlax-ename->vla-object (car(entsel)) ))   "" )

本帖子中包含更多资源

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

x
回复

使用道具 举报

gzxl
发表于 2023-6-22 09:43:03 | 显示全部楼层
我个人喜欢写成这样，感觉代码可读性好些, 0 1 2 3 时间久了都不知道是什么了。
(vla-put-Type obj acSimplePoly)
(vla-put-Type obj acFitCurvePoly)
(vla-put-Type obj acQuadSplinePoly)
(vla-put-Type obj acCubicSplinePoly)
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2023-6-22 09:55:12 | 显示全部楼层
gzxl 发表于 2023-6-22 09:43
我个人喜欢写成这样，感觉代码可读性好些, 0 1 2 3 时间久了都不知道是什么了。
(vla-put-Type obj acSimp ...

请问大神 dbx 不能使用CAD命令吗？如(vl-cmdf "convertpoly "  (vlax-vla-object->ename  ob) "")
在(vlax-for )下面
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2023-6-22 10:14:27 | 显示全部楼层
树櫴希德 发表于 2023-6-22 09:55
请问大神 dbx 不能使用CAD命令吗？如(vl-cmdf "convertpoly "  (vlax-vla-object->ename  ob) "")
在(vl ...

【话唠】t18-13nil(158675958)  10:06:24
dbx只是数据库，没有doc环境

【话唠】t18-13nil(158675958)  10:06:32
不能用命令
管理员】LLSheng_73■■■
相当于某个时候对你点名一次，至于你来没来都没事，来了不会和你互动，没来也不会找你也不找人替代你
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2023-6-23 10:28:53 | 显示全部楼层
  1. ;二维多段线与多段线互相转换
  2. (defun c:tesaa ( / &k1 &kw1 a10 a42 a70 a8 a90 ent ss1 ss2 ss5 x)
  3. (vl-load-com)
  4. (princ "\n请选择对象")
  5. (if (setq &kw1 (ssget '((0 . "*POLYLINE"))))
  6.   (progn;;1
  7.    (setq ss1 '())
  8.    (while (setq &k1 (ssname &kw1 0))
  9.     (setq &kw1 (ssdel &k1 &kw1) ss1 (cons &k1 ss1))
  10.    );while
  11.    
  12.    (if (setq ss2 (vl-remove-if-not '(lambda (x) (= (cdr (assoc 0 (entget x))) "POLYLINE")) ss1))
  13.     (progn;;2
  14.      (setq ss1 (vl-remove-if '(lambda (x) (member x ss2)) ss1))
  15.      (while (setq ent (car ss2))
  16.       (setq ss2 (cdr ss2) ss5 (s1712081 ent))
  17.       (if (vlax-curve-isClosed ent) (setq a70 '(70 . 1)) (setq a70 '(70 . 0)))
  18.       (setq a90 (cons 90 (length ss5))
  19.             ss5 (apply 'append ss5)
  20.             a8 (assoc 8 ss5)
  21.             a10 (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) ss5)
  22.             ss5 (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDbPolyline") a90 a70 '(38 . 0)) a10)
  23.       )
  24.       (entmake ss5)
  25.       (entdel ent)
  26.      );while
  27.     );progn;2
  28.    );if;2
  29.    (if (car ss1)
  30.     (progn
  31.      (while (setq ent (car ss1))
  32.       (setq ss1 (cdr ss1) ss5 (entget ent))
  33.       (setq a70 (assoc 70 ss5)
  34.             a8 (assoc 8 ss5)
  35.             a10 (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss5)
  36.             a42 (vl-remove-if-not '(lambda (x) (= (car x) 42)) ss5)
  37.             ss5 (mapcar '(lambda (x) (append (list '(0 . "VERTEX") '(100 . "AcDbEntity") '(67 . 0) a8 '(100 . "AcDbVertex") '(100 . "AcDb2dVertex")) x))
  38.             (mapcar 'cons a10 (mapcar '(lambda (x) (list x a70)) a42)))
  39.       )
  40.       (s1712082 ss5 a70 a8)
  41.       (entdel ent)
  42.      );while
  43.     )
  44.    );if;3
  45.   );progn;1
  46. );if;1
  47. (princ)
  48. )

  50. ;entmake生成二维多段线
  51. (defun s1712082 (ss5 a70 a8 / a70 a8 ed ss5)
  52. (entmake (list  '(0 . "POLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDb2dPolyline") a70))
  53. (while (setq ed (car ss5))
  54.   (setq ss5 (cdr ss5))
  55.   (entmake ed)
  56. )
  57. (entmake '((0 . "SEQEND")))
  58. )

  60. ;提取二维多段线数据
  61. (defun s1712081 (e / e ed pts)
  62.   (if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
  63.     (progn
  64.       (while (and (setq e (entnext e))
  65.                (/= (cdr (assoc 0 (setq ed (entget e)))) "SEQEND")
  66.              )
  67.         (setq pts (cons ed pts))
  68.       )
  69.     )
  70.   )
  71.   (reverse pts)
  72. )

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2023-6-23 15:34:51 | 显示全部楼层
本帖最后由 树櫴希德 于 2023-7-18 22:53 编辑


不开图批量等高线lwpoly  to  二维poly 并拟合，可以保留南方代码了  "south"

  1. ;(setq startPnt(vlax-make-safearray vlax-vbDouble '(0 . 2)))
  2. ;(vlax-safearray-fill startPnt st_point)
  3. ;(setq endPnt(vlax-make-safearray vlax-vbDouble '(0 . 2)))
  4. ;(vlax-safearray-fill endPnt p3)
  5. ;(setq Line_Obj(vla-AddLine mSpace startPnt endPnt))
  6. ;(vl-load-com )
  7. ;(vlax-dump-object(vlax-ename->vla-object(car(entsel)))T)   (entget(car(entsel))'("*"))
  8.        ;(setq xtype (vlax-make-safearray vlax-vbvariant '(0 . 1)))
  9. ;(setq xtype (vlax-make-safearray vlax-vbInteger '(0 . 1)))
  10.    ;(setq xdata (vlax-make-safearray vlax-vbvariant '(0 . 1)))
  11.          ; (vlax-safearray-fill xtype '(1001 1000))
  12.           ;(vlax-safearray-fill xdata '("loop" "loop"))
  13.           ; (vla-setxdata (vlax-ename->vla-object(car(entsel))) xtype xdata)

  15. ;(-3 ("loop" (1000 . "loop")))

  17. (defun c:GetX (/ xType XData)
  18. (vl-load-com)
  19. (setq appid "south")
  20. (setq vlaobj (car(entsel"\\n）选择环：")))
  21. (cond ((= (type vlaObj) 'ENAME) (SETQ vlaObj (vlax-ename->vla-object vlaObj)))
  22. ((= (type vlaObj) 'VLA-OBJECT) (SETQ vlaObj vlaObj))
  23. (t (setq olderror *error*)))
  24. (vla-getxdata vlaObj appid 'xType 'xData) ;；此处监视时，其值为nil
  25. (mapcar '(lambda (key val) (cons key (VLAX-VARIANT-value val)))
  26. (vlax-safearray->list xType)
  27. (vlax-safearray->list xData)
  28. )
  29. )

  31. ;(VLAX-VARIANT-value (vlax-safearray->list xData))

  33. ; (apply 'append(mapcar '(lambda (x) (list (cdr x))) (mapcar '(lambda (key val) (cons key (VLAX-VARIANT-value val)))(vlax-safearray->list xType)(vlax-safearray->list xData)))) ;;; ("SOUTH" "202101")

  35. ;(apply 'append '(("SOUTH") ("202101")))

  37. ; (mapcar '(lambda (x) (append (cdr x))) '((1001 . "SOUTH") (1000 . "202101")) )
  38. ;注意APPID是一个已经注册的应用程序名称..是REGAPP以后的名称,是字符串.


  41. (defun zhnfbm (oldobj newobj / xType  xData  xType1 xData1)
  42.     (vl-load-com)
  43. (setq appid "south")
  44.   (vla-getxdata oldobj appid 'xType 'xData) ;；此处监视时，其值为nil  
  45. (setq xType1 (vlax-safearray->list xType) )

  47. (setq xData1 (apply 'append(mapcar '(lambda (x) (list (cdr x))) (mapcar '(lambda (key val) (cons key (VLAX-VARIANT-value val)))(vlax-safearray->list xType)(vlax-safearray->list xData)))) )

  49. (setq xtype (vlax-make-safearray vlax-vbInteger '(0 . 1)))
  50.    (setq xdata (vlax-make-safearray vlax-vbvariant '(0 . 1)))
  51.           (vlax-safearray-fill xtype xType1)
  52.           (vlax-safearray-fill xdata xData1)
  53.            (vla-setxdata newobj xtype xdata)
  54.   
  55.   )

  57. ;; (zhnfbm (vlax-ename->vla-object(car(entsel)))  (vlax-ename->vla-object(car(entsel)))  )




  62.   ;(lw2pl (car(entsel)))   (entget (car(entsel))'("*"))

  64. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  65. (defun vxs (e / i v lst ppp)
  66.   (setq i 0)
  67.   (while
  68.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
  69.      (setq lst (cons v lst))
  70.   )
  71.   (setq ppp (reverse lst) )
  72. (append (list(vlax-curve-getpointatparam e 0)) ppp )
  73.   
  74.   );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75. (defun mk222 ( en mSpace  / plst plst1 points mSpace )
  76. (vl-load-com)
  77. ;(vla-AddPolyline (vxs(car(entsel))))   (vla-addlightweightpolyline (vxs(car(entsel))))
  78. ;(setq plst nil)
  79. (setq plst (vxs en) )

  81. (setq plst1 (apply 'append plst
  82.                   
  83.             ) )
  84. (setq points
  85.        (vlax-make-safearray
  86.          vlax-vbdouble
  87.          (cons 0 (- (length plst1) 1))
  88.        )
  89. )
  90. ;(vlax-safearray-fill points plst1)

  92. (setq points (vlax-safearray-fill points plst1) )

  94. (vlax-invoke-method mSpace 'AddPolyline points)

  96. ;(vla-AddPolyline   ms    points   )

  98. ;(princ)
  99. )

  101. ;(setq ms
  102.     ;   (vla-get-ModelSpace
  103.     ;     (vla-get-ActiveDocument
  104.     ;       (vlax-get-acad-object)
  105.     ;     )
  106.   ;     )
  107. ;)




  112.   ;(lw2pl (car(entsel)))   (entget (car(entsel))'("*"))
  113. ;;;;;;;;;;;;;;;;;;;;;;;

  115. ;(assoc 0(entget(car(entsel))'("*")) )

  117. (defun try-getFolder (msg / WinShell shFolder path catchit)
  118. (setq winshell (vlax-create-object "Shell.Application"))
  119. (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
  120. (setq catchit (vl-catch-all-apply
  121.            '(lambda ()
  122.              (setq shFolder (vlax-get-property shFolder 'self))
  123.              (setq path (vlax-get-property shFolder 'path))
  124.             )
  125.           )
  126. )
  127. (if (vl-catch-all-error-p catchit)
  128.   nil
  129.   path
  130. )
  131. )

  133. (defun c:mk22 (/ BANBEN DBX PATH FILES DH STR PT0 PT1 I DWGNAME temp ob obj mSpace kd ys tc biaogao kdobj bgobj lyobj ysobj objobj)




  138.   
  139.   (vl-load-com)
  140. ;(setvar "cmdecho" 0)
  141.   (initget 1 "D S F 3S")    (setq temp (getkword "(D)不拟合/(S)2次样条拟合/(3S)3次样条拟合/(F)圆弧拟合] <F>"))
  142.   (setq banben (substr (getvar "acadver") 1 2))
  143.   ;版本2004-2006返回16,2007-2009返回17,2010-2012返回18,2013返回19
  144.   (setq dbx (Vlax-Get-Or-Create-Object (strcat "ObjectDBX.AxDbDocument." banben)))
  145.   (setq path (strcat (try-getFolder "\n 选择图纸所在文件夹名称：") "\\"));文件夹路径
  146.   (setq files (vl-directory-files path "*.dwg" 1)) ;获取所有文件名
  147.   
  148.   (setq i -1)
  149.   (while (setq dwgname (nth (setq i (1+ i)) files))
  150.     (vlax-invoke-method dbx 'open (strcat path dwgname))
  151.     ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  152.      (setq mSpace (Vlax-Get dbx 'ModelSpace)) (vla-SaveAs dbx (strcat path dwgname) )
  153.     (vlax-for ob  mSpace ;历遍模型空间集合;;;;;;;;;;;;;;;;;;;;;;;;
  154.   ; (vlax-3d-point '(100 100 100))
  155.         ;(vla-save dbx)
  156. (cond  ((equal (type ob) 'ENAME) (setq obj (vlax-ename->vla-object ob)))
  157.   (T (setq obj ob))  )
  158. ;(setq circCenter (vlax-3d-point '(2.0 2.0 0.0)))
  159. ;(vlax-invoke-method mspace 'AddCircle circCenter 3.0)
  160.       
  161. (if  (and   (= (vla-get-Layer Obj) "DGX" )  (= (vlax-get-property obj 'ObjectName) "AcDbPolyline")   )

  163.    (progn
  164.      
  165. ;(Setq ms (Vlax-Get (Vlax-Get (Vlax-Get-Acad-Object) 'ActiveDocument) 'ModelSpace ))
  166.    ; (mk2d (vlax-vla-object->ename Obj) (Vlax-Get dbx 'ModelSpace))
  167. ;(vla-put-color obj 1)
  168.     ;(mk222 OBJ mSpace)
  169. (setq kd (vlax-get-property Obj  'ConstantWidth))
  170. (setq ys (vlax-get-property Obj  'color))   
  171. (setq tc (vlax-get-property Obj  'Layer))
  172. (setq biaogao (vlax-get-property Obj  'Elevation))
  173. ;;;;;;;;;;;;

  175. (setq objobj (mk222 OBJ mSpace))
  176. (vla-put-ConstantWidth objobj kd)  (vla-put-Elevation objobj biaogao) (vla-put-layer objobj tc) (vla-put-color objobj ys)
  177. (cond

  179.     ((= temp "D")   (vla-put-Type objobj  acSimplePoly) (vla-Update objobj )   )

  181.     ((= temp "F")   (vla-put-Type objobj  acFitCurvePoly) (vla-Update objobj ))

  183.     ((= temp "S")   (vla-put-Type objobj  acQuadSplinePoly) (vla-Update objobj ))

  185.     ((= temp "3S")   (vla-put-Type objobj  acCubicSplinePoly) (vla-Update objobj ))

  187.   )
  188. (zhnfbm obj  objobj  )

  190. (vla-delete obj )

  192. ;(setq kdobj (vla-put-ConstantWidth (mk222 OBJ mSpace) kd))
  193. ;(setq bgobj (vla-put-Elevation kdobj biaogao))
  194. ;(setq lyobj (vla-put-layer bgobj tc) )
  195. ;(setq ysobj (vla-put-color lyobj ys) )
  196. ;(vla-put-color (vla-put-layer (vla-put-Elevation (vla-put-ConstantWidth (mk222 OBJ mSpace) kd) biaogao)tc) ys)
  197. ;(vlax-put-property (vlax-put-property (vlax-put-property (vlax-put-property (mk222 OBJ mSpace) 'ConstantWidth kd) 'Layer tc) 'color ys) 'Elevation biaogao)

  199.    ; (vla-put-Color (mk222 OBJ mSpace) 1)
  200.     ;(lw2pl (vlax-vla-object->ename Obj))
  201.      )


  204.   )

  206.       

  208.       ;(vla-move ob (vlax-3d-point pt0)(vlax-3d-point pt1))
  209.     );;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  211.    
  212.     (vlax-invoke-method dbx 'SaveAs (strcat path dwgname))
  213.   )  ;;;;;;;;;;;;;;;;;;;;;;;;
  214.   (vlax-release-object dbx);释放
  215.   ;(setvar "cmdecho" 1)
  216.   (princ)
  217. )
  218. ;(princ "\n 不开图地形图平移代号坐标运行命令：pydhzb")
  219. ;(princ "\n 如有疑问或者好的建议请联系老仓测绘上班记QQ:729292370")
  220. ;(princ)





本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2023-7-4 15:58:33 | 显示全部楼层
树櫴希德 发表于 2023-6-23 15:34


南方等高线多段线转二维多段线  非拟合 非圆弧

  1. ;entmake生成二维多段线
  2. (defun s1712082 (ss5 a38 a-3 a62 a8 / a70 a8 ed ss5 )
  3. (entmake (list  '(0 . "POLYLINE") '(100 . "AcDbEntity") a8 '(100 . "AcDb2dPolyline") '(70 . 0) a38 a-3 a62))
  4. (while (setq ed (car ss5))
  5.   (setq ss5 (cdr ss5))
  6.   (entmake ed)
  7. )
  8. (entmake '((0 . "SEQEND")))
  9. )

  11. (defun  lw2pl  (  ent /  ss5 a70 a8 a10 a42 a70 a40 a41 a38 a-3 a62) ;ss5 a70 a8 a10 a42 a70
  12. ;(setq ent (car ss1))
  13.       (setq  ss5 (entget ent '("*") ))
  14.       (setq a70 (assoc 70 ss5)
  15.             a8 (assoc 8 ss5)
  16.       a38 (assoc 38 ss5)
  17.       a-3 (assoc -3 ss5)
  18.       a62 (assoc 62 ss5)
  19.             a10 (vl-remove-if-not '(lambda (x) (= (car x) 10)) ss5)
  20.       a40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) ss5)
  21.       a41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) ss5)
  22.             a42 (vl-remove-if-not '(lambda (x) (= (car x) 42)) ss5)
  23.             ss5 (mapcar '(lambda (x) (append (list '(0 . "VERTEX") '(100 . "AcDbEntity") '(67 . 0) a8 '(100 . "AcDbVertex") '(100 . "AcDb2dVertex")) x))
  24.           (mapcar 'cons a41 (mapcar 'cons a40 (mapcar 'cons a10 (mapcar '(lambda (x) (list x '(70 . 0))) a42)  )  ))      )
  25.       )
  26.       (s1712082 ss5 a38 a-3 a62 a8)
  27.      ; (entdel ent)
  28. (princ )
  29. )

  31.   ;(lw2pl (car(entsel)))   (entget (car(entsel))'("*"))

回复 支持 反对

使用道具 举报

树櫴希德
 楼主| 发表于 2024-4-14 12:24:41 | 显示全部楼层
  1. (setq jb (cdr (assoc 5 (entget (car(entsel ""))))))
  2. (setq newobj (vlax-ename->vla-object (car(entsel ""))  ))
  3. (regapp "ZXCAD")
  4. (setq xtype (vlax-make-safearray vlax-vbInteger '(0 . 4)))
  5.    (setq xdata (vlax-make-safearray vlax-vbvariant '(0 . 4)))
  6. (vlax-safearray-fill xtype (list 1001 1000 1002 1005 1002))
  7.           (vlax-safearray-fill xdata (list "ZXCAD" "1005的值是圆的句柄值,当用户复制到新图纸的时候cad自动更新1005的值为圆的新句柄" "{" jb "}") )
  8.            (vla-setxdata newobj xtype xdata)

回复 支持 反对

使用道具 举报

h2295
发表于 2024-7-17 13:11:14 | 显示全部楼层


(vlax-for ob (Vlax-Get dbx 'ModelSpace) ;历遍模型空间集合

出现异常。
参数类型错误: VLA 对象集合: ""是什么原因
回复 支持 反对

使用道具 举报

寒潮大冬瓜
发表于 2024-7-20 15:18:57 | 显示全部楼层
我上传一个二维多段线lwPLINETYPE→LINETYPE，同时其标高值还能继续保留的在“;修改仓老师代码，不开图批量拟合二维多段线等高线;http://bbs.mjtd.com/forum.php?mo ... &fromuid=418631;(出处: 明经CAD社区);树櫴希德发表于 2023-6-23 10:28基础上升级而成！
http://bbs.mjtd.com/forum.php?mo ... 27&page=1#pid987799
回复 支持 反对

使用道具 举报

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

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-12-23 03:10 , Processed in 0.175655 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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