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

帮助：Lisp绘制pline acr

任何人都可以使用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

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


(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

 
试试这个，让我知道。
 

(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

请尝试以下操作：
(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)
)

vernonlee 发表于 2022-7-5 22:23:21

谢谢大家的回复。
 
明天我回办公室时会测试一下。
 
到了2000年，它将绘制新的普林线。

Tharwat 发表于 2022-7-5 22:26:17

李，多段线操作很好
 
如果重新折叠的多段线的样式为书法，则可能需要删除多段线的41 dxf值。

Lee Mac 发表于 2022-7-5 22:31:34

 
谢谢Tharwat
 
 
很好，我已经更新了上面的代码。
 
 
不客气-祝你好运！
页: [1] 2
查看完整版本: 帮助：Lisp绘制pline acr