获取封闭矩形顶点坐标

飞雪神光 · 发表于 2023-6-15 19:49:55

kzd2004 发表于 2023-6-15 08:08
大佬，提示输入的列表有缺陷，请保存lsp文件发给我，成分感谢！

你直接用TXT保存的？那要保存成ANSI编码最好还是复制到编辑器保存

kzd2004 · 发表于 2023-6-15 19:55:35

飞雪神光发表于 2023-6-15 19:49
你直接用TXT保存的？那要保存成ANSI编码最好还是复制到编辑器保存

谢谢你的回复，感谢感谢!

ocoipw · 发表于 2023-6-15 20:44:03

;;;获取曲线的顶点
(defun get_pline-vertexs (et / i v lst)
  (setq en (car (entsel)));;选择曲线并获取名称
  (setq et (vlax-ename->vla-object en));;将实体转换为vla对象
  (setq i 0);;计数器赋初值
  (while (setq v (vlax-curve-getpointatparam et (setq i (1+ i))));;沿曲线返回指定参数值处的点。
(setq lst (cons v lst))
  )
  (reverse lst)
)
;;;使用方法：
;;;在命令行输入

get_pline-vertexs et)

ocoipw · 发表于 2023-6-15 20:45:46

(get_pline-vertexs et)

kzd2004 · 发表于 2023-6-16 08:15:18

本帖最后由 kzd2004 于 2023-6-16 13:26 编辑

ocoipw 发表于 2023-6-15 20:45
(get_pline-vertexs et)

真心感谢你的无私回复，谢谢了

能不能这样啊

kzd2004 · 发表于 2023-7-26 14:04:24

飞雪神光发表于 2023-6-14 19:26

你好，代码很好，我是小白，请问这个用什么命令能调出来？能把这个直接改成画对角线吗？谢谢你了。

飞雪神光 · 发表于 2023-7-26 14:46:48

kzd2004 发表于 2023-7-26 14:04
你好，代码很好，我是小白，请问这个用什么命令能调出来？能把这个直接改成画对角线吗？谢谢你了。

命令就是TT

(defun c:tt (/ gr lmts loop p1 p2 p3 p4 pt s1 s2 s3 s4 screen ys yx zs zx)
(defun screen(/ c03 c08 c04 c05 c07 c06 c09 c01 c02);
(setq
c03 (trans (getvar "viewctr") 1 2)
c08 (getvar "viewsize")
c04 (getvar "screensize")
c09 (/ (* c08 (car c04)) (cadr c04))
c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))
c01 (trans c01 2 1)
c02 (trans c02 2 1)
)
(list c01 c02)
)
(setq loop t)
(while loop
(setq gr (grread t 15 0))
(cond
((= 5 (car gr))
(setq lmts (screen))
(setq pt (cadr gr))
(if(and
(setq S1 (ssget "F" (LIST pt (list (car pt) (cadadr lmts)))'((0 . "*line"))))
(setq S2 (ssget "F" (LIST pt (list (car pt) (cadar lmts)))'((0 . "*line"))))
(setq S3 (ssget "F" (LIST pt (list (caar lmts) (cadr pt)))'((0 . "*line"))))
(setq S4 (ssget "F" (LIST pt (list (caadr lmts)(cadr pt)))'((0 . "*line"))))
)
(progn
(setq P1 (trans (cadr(nth 3 (car (ssnamex S1)))) 0 1));上
(setq P2 (trans (cadr(nth 3 (car (ssnamex S2)))) 0 1));下
(setq P3 (trans (cadr(nth 3 (car (ssnamex S3)))) 0 1));左
(setq P4 (trans (cadr(nth 3 (car (ssnamex S4)))) 0 1));右
(setq
ys(list (car p4) (cadr p1))
yx(list (car p4) (cadr p2))
zx(list (car p3) (cadr p2))
zs(list (car p3) (cadr p1))
)
(redraw)
(grdraw zx zs 4)
(grdraw zs ys 4)
(grdraw ys yx 4)
(grdraw zx yx 4)
(grdraw zx ys 190)
(grdraw zs yx 190)
)
(redraw)
)
)
((= 3 (car gr))
(setq loop nil)
(redraw)
(entmake (list '(0 . "line")(cons 10 zx)(cons 11 ys)))
(entmake (list '(0 . "line")(cons 10 zs)(cons 11 yx)))
)
)
)
(princ)
)

(defun c:tt (/ gr lmts loop p1 p2 p3 p4 pt s1 s2 s3 s4 screen ys yx zs zx) 
  (defun screen(/ c03 c08 c04 c05 c07 c06 c09 c01 c02); 
    (setq   
      c03 (trans (getvar "viewctr") 1 2) 
      c08 (getvar "viewsize") 
      c04 (getvar "screensize") 
      c09 (/ (* c08 (car c04)) (cadr c04)) 
      c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08))) 
      c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08))) 
      c01 (trans c01 2 1) 
      c02 (trans c02 2 1) 
    ) 
    (list c01 c02) 
  ) 
  (setq loop t) 
  (while loop 
    (setq gr (grread t 15 0)) 
    (cond 
      ((= 5 (car gr)) 
        (setq lmts (screen)) 
        (setq pt (cadr gr)) 
        (if(and 
             (setq S1 (ssget "F" (LIST pt (list (car pt) (cadadr lmts)))'((0 . "*line")))) 
             (setq S2 (ssget "F" (LIST pt (list (car pt) (cadar  lmts)))'((0 . "*line")))) 
             (setq S3 (ssget "F" (LIST pt (list (caar lmts) (cadr pt)))'((0 . "*line")))) 
             (setq S4 (ssget "F" (LIST pt (list (caadr lmts)(cadr pt)))'((0 . "*line")))) 
           ) 
          (progn 
            (setq P1 (trans (cadr(nth 3 (car (ssnamex S1)))) 0 1));上 
            (setq P2 (trans (cadr(nth 3 (car (ssnamex S2)))) 0 1));下 
            (setq P3 (trans (cadr(nth 3 (car (ssnamex S3)))) 0 1));左 
            (setq P4 (trans (cadr(nth 3 (car (ssnamex S4)))) 0 1));右 
            (setq 
              ys(list (car p4) (cadr p1)) 
              yx(list (car p4) (cadr p2)) 
              zx(list (car p3) (cadr p2)) 
              zs(list (car p3) (cadr p1)) 
            ) 
            (redraw) 
            (grdraw zx zs 4) 
            (grdraw zs ys 4) 
            (grdraw ys yx 4) 
            (grdraw zx yx 4) 
            (grdraw zx ys 190) 
            (grdraw zs yx 190) 
          ) 
          (redraw) 
        ) 
      ) 
      ((= 3 (car gr)) 
        (setq loop nil) 
                                (redraw) 
                                (entmake (list '(0 . "line")(cons 10 zx)(cons 11 ys))) 
                                (entmake (list '(0 . "line")(cons 10 zs)(cons 11 yx))) 
      ) 
    ) 
  ) 
  (princ) 
)

kzd2004 · 发表于 2023-7-27 22:55:40

飞雪神光发表于 2023-7-26 14:46
命令就是TT

真诚的谢谢你啊！！！

kzd2004 · 发表于 2023-8-12 07:30:34

本帖最后由 kzd2004 于 2023-8-12 07:44 编辑

飞雪神光发表于 2023-7-26 14:46
命令就是TT

恳请大佬帮我改成这样的门开虚线，鼠标在左侧就是左开虚线，在右边就是右开虚线，谢谢你了。

xyp1964 · 发表于 2023-8-12 07:49:00

(defun c:tt ()
 "画矩形内部对角线"
 (while (setq p0 (getpoint "\n拾取矩形内部点<退出>: "))
(bpoly p0)
(setq s1 (entlast))
(setq ptn (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1))
 ptn (mapcar 'cdr ptn)
)
(entdel s1)
(command "line" "non" (car ptn) "non" (caddr ptn) "")
(command "line" "non" (cadr ptn) "non" (cadddr ptn) "")
 )
 (princ)
)

账号		自动登录	找回密码
密码			注册

[源码] 获取封闭矩形顶点坐标

本帖子中包含更多资源

本帖子中包含更多资源