dcl1214 发表于 2024-9-1 19:35:01

更新三维多线坐标

(DEFUN $gen-xin-3Dpline-zuo-biao$ (ent pts / b g h i)
          ;更新3Dpl线的坐标，更新直线坐标，不能是多个list，只能是一个list
(if (and ent pts)
    (PROGN
      (if (and (> (length pts) 1)
         (= (type (car pts)) 'list)
         (= (length (car pts)) 3)
    )
(progn
    (setq b (vlax-ename->vla-object ent))
    (or (AND (= (vla-get-objectname b) "AcDb3dPolyline")
       (setq
         pts
          (mapcar (function (lambda (a) (list (car a) (cadr a) 0)))
            pts
          )
       )
      )      ;这里确保是三维点坐标
      (AND (= (vla-get-objectname b) "AcDbPolyline")
       (setq
         pts
          (mapcar (function (lambda (a) (list (car a) (cadr a))))
            pts
          )
       )
      )      ;这里确保是二维点坐标
    )
    (setq pts (apply 'append pts)) ;拼接成一个list
)
      )
      (setq b (vlax-ename->vla-object ent)) ;(setq ent(car(entsel)))
      (setq g pts)
      (setq h (vl-catch-all-apply
    'vlax-make-safearray
    (LIST vlax-vbDouble (cons 0 (1- (length g))))
      )
      )
      (setq
i (vl-catch-all-apply 'vlax-safearray-fill (LIST h g))
      )
      (vl-catch-all-apply
'vla-put-Coordinates
(LIST b (vl-catch-all-apply 'vlax-make-variant (list i)))
      )
      (vl-catch-all-apply 'vla-update (LIST b))
    )
)
)

w379106181 发表于 2024-9-1 20:03:22


感谢分享

寒潮大冬瓜 发表于 2024-9-1 21:08:19

很好→很棒！很好~很棒！！很好……很棒！！！
页: [1]
查看完整版本: 更新三维多线坐标