帮助：Lisp绘制pline acr

vernonlee · 发表于 2022-7-5 21:55:08

任何人都可以使用Lisp绘制跨越云线修订所有端点的pline？

谢谢

Tharwat · 发表于 2022-7-5 22:00:23

显示图像或样例图形以了解更多详细信息。

vernonlee · 发表于 2022-7-5 22:03:38

红色是修订云。

希望Lisp程序的画绿线根据照片。

如果LISP允许我打开一束云，而不是1乘1，那将是最好的。

谢谢

hanhphuc · 发表于 2022-7-5 22:08:59

没有代码，只有命令，如果不起作用，可以修改它

copy


(command "_copy" "si" "\""\" "") ; copy the revcloud
(command "_pasteori" "0,0,0") ; paste to origin 
(command "_PEDIT" "l" "D" "") ; decurve the "cloned revcloud"

HTH公司

asos2000 · 发表于 2022-7-5 22:11:19

要将云转换为PLINE还是添加新的PLINE？

Tharwat · 发表于 2022-7-5 22:16:00

试试这个，让我知道。

copy


(defun c:test (/ ss l)
 ;;        Tharwat 01.12.2014        ;;
 (if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
   ((lambda (i / sn)
      (while (setq sn (ssname ss (setq i (1+ i))))
        (setq l nil
              l (vl-remove-if-not
                  '(lambda (x) (eq (car x) 10))
                  (entget sn)
                )
        )
        (entmake
          (append
            (list '(0 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  (cons 90 (length l))
                  (cons 70
                        (if (vlax-curve-isclosed sn)
                          1
                          0
                        )
                  )
            )
            (mapcar '(lambda (p) (cons 10 (list (cadr p) (caddr p))))
                    l
            )
          )
        )
      )
    )
     -1
   )
 )
 (princ)
)

Lee Mac · 发表于 2022-7-5 22:19:56

请尝试以下操作：

copy

(defun c:revpl ( / i s )
   (if (setq s (ssget '((0 . "LWPOLYLINE"))))
       (repeat (setq i (sslength s))
           (entmake (vl-remove-if '(lambda ( x ) (< 39 (car x) 43)) (entget (ssname s (setq i (1- i))))))
       )
   )
   (princ)
)