pline-继续绘制乐筑天下 - Powered by Discuz! Archiver

77077 发表于 2022-7-5 22:26:52

pline-继续绘制

大家好。
这个Lisp程序可以继续绘制“pline”，但只能在末尾绘制。可以选择在“端点”或“起点”重新绘制吗？？

(defun c:test (/ oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)
(command "undo" "be")
(setq oce1 (getvar "cmdecho")
oce2 (getvar "PLINEWID")
oce3 (getvar "OSMODE")
oce4 (getvar "CECOLOR")
oce5 (getvar "LWDEFAULT")
)
(setvar "cmdecho" 0)
(setvar "OSMODE" 39)
(setvar "PLINETYPE" 2)

(defun vxs (e / i v lst)
(setq i -1)
(while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)

(setq SS (entsel "\nPlease choose one pline:"))
(setq en (car SS))
(setq ent (entget en))
(if (or
(= (cdr (assoc 0 ent)) "POLYLINE")
(= (cdr (assoc 0 ent)) "LWPOLYLINE")
)
(progn
(setq lst (vxs en))
(if (= (cdr (assoc 0 ent)) "POLYLINE")
(progn
(if (/= (assoc 62 ent) nil)
(setvar "CECOLOR" (rtos (cdr (assoc 62 ent)) 2 0))
(setvar "CECOLOR" "BYLAYER")
)
(if (/= (assoc 370 ent) nil)
(setvar "LWDEFAULT" (cdr (assoc 370 ent)))
)
(command "3dpoly")
(foreach pt lst
(command pt)
)
(while (/= (getvar "cmdactive") 0)
(command pause)
)
(setq en1 (entlast))
(command "_matchprop" en en1 "")
(command "_erase" en "")
)
(progn
(setq lw (cdr (assoc 43 ent)))
(if (= lw nil)
(setq lw (cdr (assoc 40 ent)))
)
?
(setq pt (last lst))
(command "pline" pt "w" lw lw)
(while (/= (getvar "cmdactive") 0)
(cond
   ((or
(equal (grread t'(2 67))
(equal (grread t'(2 99))
   )
(command (car lst) "")
   )
   ((= (car (grread t ) 11)
(command "")
   )
   (t
(command pause)
   )
)
)
(setq en1 (entlast))
(command "_matchprop" en en1 "")
(command "_join" en1 en "")
)
)
)
(alert "Your choose is not a pline")
)
(setvar "cmdecho" oce1)
(setvar "PLINEWID" oce2)
(setvar "OSMODE" oce3)
(setvar "CECOLOR" oce4)
(setvar "LWDEFAULT" oce5)
(command "undo" "e")
(princ)
)

7o7 发表于 2022-7-5 22:34:50

试试这个。

(defun c:test (/ oce1 oce2 oce3 oce4 oce5 vxs ss en ent en1 lst pt lw)
(command "undo" "be")
(setq oce1 (getvar "cmdecho")
oce2 (getvar "PLINEWID")
oce3 (getvar "OSMODE")
oce4 (getvar "CECOLOR")
oce5 (getvar "LWDEFAULT")
)
(setvar "cmdecho" 0)
(setvar "OSMODE" 39)
(setvar "PLINETYPE" 2)

(defun vxs (e / i v lst)
(setq i -1)
(while (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(reverse lst)
)

(setq SS (entsel "\nPlease choose one pline:"))
(setq en (car SS))
(setq enl (last SS))
(setq ent (entget en))
(if (or (= (cdr (assoc 0 ent)) "POLYLINE")
(= (cdr (assoc 0 ent)) "LWPOLYLINE")
)
(progn
(setq lst (vxs en))
(setq lst (if (< (distance enl (car lst)) (distance enl (last lst)))
      (reverse lst) lst))
(if (= (cdr (assoc 0 ent)) "POLYLINE")
(progn
(if (/= (assoc 62 ent) nil)
(setvar "CECOLOR" (rtos (cdr (assoc 62 ent)) 2 0))
(setvar "CECOLOR" "BYLAYER"))
(if (/= (assoc 370 ent) nil)
(setvar "LWDEFAULT" (cdr (assoc 370 ent)))
)
(command "3dpoly")
(foreach pt lst (command pt))
(while (/= (getvar "cmdactive") 0)
(command pause)
)
(setq en1 (entlast))
(command "_matchprop" en en1 "")
(command "_erase" en "")
)
(progn
(setq lw (cdr (assoc 43 ent)))
(if (= lw nil)
(setq lw (cdr (assoc 40 ent)))
)
(setq pt (if (< (distance enl (car lst)) (distance enl (last lst)))
      (car lst) (last lst)))
(command "pline" pt "w" lw lw)
(while (/= (getvar "cmdactive") 0)
(cond((or (equal (grread t'(2 67))
(equal (grread t'(2 99))
   )
   (command (car lst) ""))
   ((= (car (grread t ) 11)
   (command "")
   )
   (t (command pause))
         )
      )
      (setq en1 (entlast))
      (command "_matchprop" en en1 "")
      (command "_join" en1 en "")
   )
)
)
(alert "Your choose is not a pline")
)
(setvar "cmdecho" oce1)
(setvar "PLINEWID" oce2)
(setvar "OSMODE" oce3)
(setvar "CECOLOR" oce4)
(setvar "LWDEFAULT" oce5)
(command "undo" "e")
(princ)
)

77077 发表于 2022-7-5 22:44:17

嗨，兄弟。
非常感谢！美好的
输入关键字“C”关闭，有问题。

7o7 发表于 2022-7-5 22:50:20

您必须更改输入法，而不是（命令“暂停”）。

77077 发表于 2022-7-5 22:53:55

谢谢你，兄弟
“关闭”也有问题。
(defun c:test ( / en ent en1 pt lw)
      (command "undo" "be")
   (setq en(entsel "\nPlease choose one pline:"))
   (setq pt (osnap (cadr en) "end"))
      (setq ent (entget (car en)))
   (if (= (cdr (assoc 0 ent)) "LWPOLYLINE")
   (progn
            (setq lw (cdr (assoc 43 ent)))
            (if (= lw nil) (setq lw (cdr (assoc 40 ent))))
            (command ".pline"pt "w" lw lw)
   (while(/=(getvar"cmdactive")0)(command pause))
            (setq en1 (entlast))
            (command "_matchprop"en en1 "")
            (command "_join"en1 en "")
                        )

   (alert "Your choose is not a pline")
)
(command "undo" "e")
(princ)
)

77077 发表于 2022-7-5 22:57:45

嗨，伙计们，我需要帮助。

7o7 发表于 2022-7-5 23:04:27

您必须这样更改输入法：

(defun c:test ( / en ent en1 pt lw)
   (command "undo" "be")
   (setq en(entsel "\nPlease choose one pline:")
closep nil)
   (setq pt (osnap (cadr en) "end"))
   (setq ent (entget (car en)))
   (if (= (cdr (assoc 0 ent)) "LWPOLYLINE")
   (progn
            (setq lw (cdr (assoc 43 ent)))
            (if (= lw nil) (setq lw (cdr (assoc 40 ent))))
            (command ".pline"pt "w" lw lw)
   (while (and (/= (getvar"cmdactive") 0) (not closep))
(setq pnt (grread t))
(cond ((and (= 2 (car pnt)) (or (= (last pnt) 99) (= (last pnt) 67)))
            (setq closep t) (command ""))
               ((and (= 2 (car pnt)) (or (= (last pnt) 32) (= (last pnt) 13)))
            (command ""))
   ((= 3 (car pnt)) (command (last pnt))))
)
   (setq en1 (entlast))
   (command "_matchprop"en en1 "")
   (command "_join"en1 en "")
(if closep (command "pedit" (entlast) "C" ""))
)
(alert "Your choose is not a pline")
)
(command "undo" "e")
(princ)
)

77077 发表于 2022-7-5 23:10:44

谢谢你，兄弟。太酷了！
但只输入关键字“C”，所以只画直线，怎么画圆弧？

7o7 发表于 2022-7-5 23:19:46

与“c”相同，ascii代码表示“a”。

77077 发表于 2022-7-5 23:23:57

好啊我知道。非常感谢！兄弟

页: [1] 2

乐筑天下's Archiver

pline-继续绘制