ajunseo 发表于 2021-6-20 10:20:47

求写一个矩形画叉插件

本帖最后由 ajunseo 于 2021-6-20 10:30 编辑

求写一个矩形画叉插件，中间矩形虚线，8号色

chenbh2 发表于 2021-9-13 14:08:04

(command "RECTANGLE" "non" (setq p1 (getpoint "\n点1:")) "non" (setq p2 (getcorner p1 "\n点2:")) "line" "non" p1 "non" p2 "" "line" "non" (list (car p1) (cadr p2)) "non" (list (car p2) (cadr p1)) "")

xj6019 发表于 2021-6-20 11:22:01

(DEFUN C:CRE (/ OLD_LAY SS I S ENT PT LEN))
(vl-load-com)
(setq old_lay (getvar "clayer"))
(if (not (tblsearch "layer" "HIDDEN"))
(command "._layer" "m" "HIDDEN" "c" "8" "" "lt" "HIDDEN" "" "LW"
         "0.05" "" "")
               )
                  (setvar "clayer" "HIDDEN")
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
(setq i 0 s nil)
(if ss (progn
         (repeat (sslength ss)
            (setq ent (entget (ssname ss i)))
            (if (= -1 (vlax-get (vlax-ename->vla-object (ssname ss i)) 'closed))
            (progn
                (foreach lst ent
                  (if (= 10 (car lst))
                     (setq s (append s (list (cdr lst))))
                  )
                )
                (setq pt 0)
                (setq len (length s))
                (if (= len 4) (setq len 2))
                (while (> len pt)
                (command "LINE" (nth pt s) (nth (if (>= (+ 2 pt) (length s))(- (+ 2 pt) (length s)) (+ 2 pt)) s) "")
                (setq pt (1+ pt))
            )
            (setq s nil)
            )
            (princ "\n所选多段线不闭合.")
            )
            (setq i (1+ i))
      )
      )               
      (princ "\n未选择多段线.")
)
(setvar "clayer" old_lay)
(princ)
)

烟盒迷唇 发表于 2021-6-20 11:43:03

(defun c:tt (/ p1 p2 p3 p4)
        (setq p1 (getpoint "\n矩形插入点：")
                p3 (getpoint p1 "\n对角点：")
                p2 (list (car p3) (cadr p1))
                p4 (list (car p1) (cadr p3))
        )
        (entmake
    (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        '(70 . 1)
                        '(90 . 5)
                        (cons 10 p1)
                        (cons 10 p2)
                        (cons 10 p3)
                        (cons 10 p4)
                        (cons 10 p1)
    )
)
(entmake
    (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        '(90 . 2)
                        '(6 . "DASHED")
                        '(62 . 8)
                        (cons 10 p1)
                        (cons 10 p3)
    )
)
        (entmake
    (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        '(90 . 2)
                        '(6 . "DASHED")
                        '(62 . 8)
                        (cons 10 p2)
                        (cons 10 p4)
    )
)
        (princ)
)

mokson 发表于 2021-6-20 14:01:34

我也一直想有这样的方法，现在终于实现了。

ajunseo 发表于 2021-6-20 18:11:02

烟盒迷唇 发表于 2021-6-20 11:43
(defun c:tt (/ p1 p2 p3 p4)
        (setq p1 (getpoint "\n矩形插入点：")
                p3 (getpoint p1 "\n对角点：") ...

好像用不了，可以画出矩形，但没有叉！

ajunseo 发表于 2021-6-20 18:13:01

xj6019 发表于 2021-6-20 11:22
(DEFUN C:CRE (/ OLD_LAY SS I S ENT PT LEN))
(vl-load-com)
(setq old_lay (getvar "clayer"))


加载后显示语法错误呢！

xj6019 发表于 2021-6-20 18:20:48

ajunseo 发表于 2021-6-20 18:13
加载后显示语法错误呢！


(DEFUN C:CRE (/ OLD_LAY SS I S ENT PT LEN)
(vl-load-com)
(setq old_lay (getvar "clayer"))
(if (not (tblsearch "layer" "HIDDEN"))
(command "._layer" "m" "HIDDEN" "c" "8" "" "lt" "HIDDEN" "" "LW"
         "0.05" "" "")
               )
                  (setvar "clayer" "HIDDEN")
(setq ss (ssget ":S" '((0 . "LWPOLYLINE"))))
(setq i 0 s nil)
(if ss (progn
         (repeat (sslength ss)
            (setq ent (entget (ssname ss i)))
            (if (= -1 (vlax-get (vlax-ename->vla-object (ssname ss i)) 'closed))
            (progn
                (foreach lst ent
                  (if (= 10 (car lst))
                     (setq s (append s (list (cdr lst))))
                  )
                )
                (setq pt 0)
                (setq len (length s))
                (if (= len 4) (setq len 2))
                (while (> len pt)
                (command "LINE" (nth pt s) (nth (if (>= (+ 2 pt) (length s))(- (+ 2 pt) (length s)) (+ 2 pt)) s) "")
                (setq pt (1+ pt))
            )
            (setq s nil)
            )
            (princ "\n所选多段线不闭合.")
            )
            (setq i (1+ i))
      )
      )               
      (princ "\n未选择多段线.")
)
(setvar "clayer" old_lay)
(princ)
)

ajunseo 发表于 2021-6-20 18:34:01

xj6019 发表于 2021-6-20 18:20
(DEFUN C:CRE (/ OLD_LAY SS I S ENT PT LEN)
(vl-load-com)
(setq old_lay (getvar "clayer"))


输入命令后，显示参数太少呢！

paulpipi 发表于 2021-6-20 19:15:11

烟盒迷唇 发表于 2021-6-20 19:18:13

ajunseo 发表于 2021-6-20 18:11
好像用不了，可以画出矩形，但没有叉！

你的CAD有问题吧，我都测试过了没问题
页: [1] 2 3
查看完整版本: 求写一个矩形画叉插件