xvbzcmn 发表于 2020-12-8 16:58:04

矩形等分小程序，运行报错

请问各位前辈，我最近写了一个小程序，想要将一个矩形等分为多个小矩形，中间留有一定间隙。运行程序后发现，有些矩形可以等分，有些矩形等分过程中电脑直接死机，请问各位前辈可以帮忙看一下吗？程序如下：
(defun c:mm ()
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
(setq ent (entsel "选择对象:"))
(command "offset" 10 ent 1 "")
(setq ent1 (entlast))
(setq ent_data (entget ent1))
(setq name (cdr (assoc 0 ent_data)))
(setq jdgs (cdr (assoc 90 ent_data)))
(setq ort (getint "沿x/y向拆分:"))
(setq nn (getint "拆分的块数:"))
(setq hj 300)

(if (and (= name "LWPOLYLINE") (= jdgs 4))
    (progn
      (setq pts (mapcar 'cdr (vl-remove-if '(lambda(x)(/= (car x) 10)) ent_data)))
      (setq p1 (car pts)
      p2 (cadr pts)
            p3 (caddr pts)
      p4 (cadddr pts)
      )
      (setq c1 (distance p1 p2))
      (setq c2 (distance p1 p4))

      (if (= ort 1)
      (progn (princ "沿x方向拆分:")
         (setq bb (- (/ (+ c2 hj) nn) hj))
         (if (= (rem bb 10) 0)
               (progn (setq pp3 (list (+ (car p1) c1) (- (cadr p1) bb) 0))
                  (command "rectang" p1 pp3)
            (command "snapang" Pause)
            (command "_array" (entlast) "" "R" nn 1 (- 0 (+ hj bb)) "")
         )
   (progn
       (while (/= (rem bb 10) 0)
         (setq hj (+ hj 5))
         (setq bb (- (/ (+ c2 hj) nn) hj))
       )
                   (setq pp3 (list (+ (car p1) c1) (- (cadr p1) bb) 0))
             (command "rectang" p1 pp3)
       (command "snapang" Pause)
       (command "_array" (entlast) "" "R" nn 1 (- 0 (+ hj bb)) "")
   )
         )
)
      )

      (if (= ort 2)
      (progn (princ "沿y方向拆分:")
         (setq aa (- (/ (+ c1 hj) nn) hj))
         (if (= (rem aa 10) 0)
               (progn (setq pp3 (list (+ (car p1) aa) (- (cadr p1) c2) 0))
                  (command "rectang" p1 pp3)
            (command "snapang" Pause)
            (command "array" (entlast) "" "r" 1 nn (+ hj aa) "")
         )
   (progn
       (while (/= (rem aa 10) 0)
         (setq hj (+ hj 5))
         (setq aa (- (/ (+ c1 hj) nn) hj))
       )
                   (setq pp3 (list (+ (car p1) aa) (- (cadr p1) c2) 0))
             (command "rectang" p1 pp3)
       (command "snapang" Pause)
       (command "array" (entlast) "" "r" 1 nn (+ hj aa) "")
   )
         )
)
      )
    )
)
(command "_.ERASE" ent "" )
(command "_.ERASE" ent1 "" )
(princ)
)



start4444 发表于 2020-12-8 17:46:39

(command "offset" 10 ent 1 "")这句不可靠，内外偏移都有可能

tigcat 发表于 2020-12-8 19:50:43

start4444 发表于 2020-12-8 17:46
(command "offset" 10 ent 1 "")这句不可靠，内外偏移都有可能

大侠分析好有效率，就看出问题来了。

bai2000 发表于 2020-12-8 20:40:37

start4444 发表于 2020-12-8 17:46
(command "offset" 10 ent 1 "")这句不可靠，内外偏移都有可能

怎么改进？

wzg356 发表于 2020-12-8 21:07:48

本帖最后由 wzg356 于 2020-12-8 21:12 编辑

bai2000 发表于 2020-12-8 20:40
怎么改进？
(vla-Offset (vlax-ename->vla-object ent) 10)；前进方向右侧偏移10
(vla-Offset (vlax-ename->vla-object ent) -10)；前进方向左侧偏移10
(command "rectang"。。。。) 的矩形，放大偏移10==》 (vla-Offset (vlax-ename->vla-object ent) -10)
页: [1]
查看完整版本: 矩形等分小程序，运行报错