明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 284|回复: 2

[源码] 更新三维多线坐标

[复制链接]
发表于 2024-9-1 19:35:01 | 显示全部楼层 |阅读模式
  1. (DEFUN $gen-xin-3Dpline-zuo-biao$ (ent pts / b g h i)
  2.           ;更新3Dpl线的坐标,更新直线坐标,不能是多个list,只能是一个list
  3.   (if (and ent pts)
  4.     (PROGN
  5.       (if (and (> (length pts) 1)
  6.          (= (type (car pts)) 'list)
  7.          (= (length (car pts)) 3)
  8.     )
  9.   (progn
  10.     (setq b (vlax-ename->vla-object ent))
  11.     (or (AND (= (vla-get-objectname b) "AcDb3dPolyline")
  12.        (setq
  13.          pts
  14.           (mapcar (function (lambda (a) (list (car a) (cadr a) 0)))
  15.             pts
  16.           )
  17.        )
  18.         )        ;这里确保是三维点坐标
  19.         (AND (= (vla-get-objectname b) "AcDbPolyline")
  20.        (setq
  21.          pts
  22.           (mapcar (function (lambda (a) (list (car a) (cadr a))))
  23.             pts
  24.           )
  25.        )
  26.         )        ;这里确保是二维点坐标
  27.     )
  28.     (setq pts (apply 'append pts)) ;拼接成一个list
  29.   )
  30.       )
  31.       (setq b (vlax-ename->vla-object ent)) ;(setq ent(car(entsel)))
  32.       (setq g pts)
  33.       (setq h (vl-catch-all-apply
  34.     'vlax-make-safearray
  35.     (LIST vlax-vbDouble (cons 0 (1- (length g))))
  36.         )
  37.       )
  38.       (setq
  39.   i (vl-catch-all-apply 'vlax-safearray-fill (LIST h g))
  40.       )
  41.       (vl-catch-all-apply
  42.   'vla-put-Coordinates
  43.   (LIST b (vl-catch-all-apply 'vlax-make-variant (list i)))
  44.       )
  45.       (vl-catch-all-apply 'vla-update (LIST b))
  46.     )
  47.   )
  48. )

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2024-9-1 21:08:19 | 显示全部楼层
很好→很棒!很好~很棒!!很好……很棒!!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-9-23 20:20 , Processed in 0.257962 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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