江南十笑 发表于 2020-9-28 09:31:52

下面代码哪个地方有问题

如下图一些软件生成的独立基础每个内框和外框 均为多线段4条对角线为斜直线所有线图层颜色均相同 现在想把所有外框切换一个图层S-BASE我东拼西凑了下面代码运行起来还是有问题少量框选不起作用   全部框选 有的内外框都变图层了 请大佬看看哪里有问题;独基外轮廓
(defun c:222( )

(setq ss (ssget ' ((0 . "LWPOLYLINE")(90 . 4))))



(setq i 0 n (sslength ss)   )

(while (< i n)(setqspl(ssname ss i))
   (setq pts ( get-pline-point spl ))
(setq ssObjects (ssget "_WP" (rm-lst pts) '((0 . "LWPOLYLINE") (90 . 4))))

    (if ( = ssObjects nil )
    ( ssdel spl ss )

    )
    (setq i (1+ i))
)

(command "change" ss "" "p" "la""S-BASE""")




(princ)
)



; ssget   0   线   90顶点个数—>ss
; ss ->转换为顶点加该图元地址
; 用范围选择，判断内有无矩形
; 无ssdel
; 输出最终的ss




(defun get-pline-point (ent / ptlist ptlist1 re)
(setq ptlist '() ptlist1 '() n 0)
(setq ptlist (vlax-safearray->list
                (vlax-variant-value
                  (vlax-get-property
                  (vlax-ename->vla-object ent)
                  'Coordinates
                  )
                  )
                )
       )
(cond
    (
   (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)
                                 )
                        )
      )
    (progn
      (repeat (/ (length ptlist) 2)
      (setq ptlist1 (cons (list (nth n ptlist)
                                  (nth (setq n (1+ n)) ptlist)
                                  )
                            ptlist1)                           
            )
      (setq n (1+ n))
      )
      )
   )
    (
   (= "POLYLINE" (cdr (assoc 0 (entget ent)
                              )
                     )
   )
    (progn
      (repeat (/ (length ptlist) 3)
      (setq ptlist1 (cons (list (nth n ptlist)
                                  (nth (setq n (1+ n)) ptlist)
                                  (nth (setq n (1+ n)) ptlist)
                                  )
                            ptlist1)
            )
      (setq n (1+ n))
      )
      )
   )
    )
   
(setq re (reverse ptlist1))
re
)


;;;删除表中重复的子表
(defun rm-lst (ptlst)
   (setq ptlst-new '())
   (while (setq pt1 (car ptlst))
       (setq ptlst-new (cons pt1 ptlst-new)
   ptlst         (vl-remove pt1 ptlst)
       )
   )
   (setq ptlst-new (reverse ptlst-new))
   ptlst-new
)


江南十笑 发表于 2020-9-28 09:32:22

本帖最后由 江南十笑 于 2020-9-28 12:12 编辑

gaics 发表于 2020-9-28 14:25:09

本帖最后由 gaics 于 2020-9-28 14:46 编辑

(defun c:222 (/ ss i n spl pts ssObjects)
(setq ss (ssget '((0 . "LWPOLYLINE") (90 . 4))))
(setq      i 0
      n (sslength ss)
)
(repeat n                                                             ;;;while改为repeat
    (setq spl (ssname ss i))
    (setq pts (get-pline-point spl))
    (setq ssObjects (ssget "_WP"
                           (rm-lst pts)
                           '((0 . "LWPOLYLINE") (90 . 4))
                  )
    )
    (if      (= ssObjects nil)
      (ssdel spl ss)
      (setq i (1+ i))                                                ;;;ssObjects不为nil时 i+1
    )
)
(if (> (sslength ss) 0)
    (command "change" ss "" "p" "la" "S-BASE" "")
)
(princ)
)

当ssObjects为nil，从ss中删除spl，此时“i”值不能变；当ssObjects不为nil时，i+1。while改为repeat，因为“i”值可能不会大于等于“n”，就是死循环。

江南十笑 发表于 2020-9-28 18:33:37

gaics 发表于 2020-9-28 14:25

当ssObjects为nil，从ss中删除spl，此时“i”值不能变；当ssObjects不为nil时 ...

谢谢大佬   已测试成功我在仔细研究一下逻辑

江南十笑 发表于 2020-9-28 18:35:56

就是从选择集中删除一个图元 后面图元的i值会自动往前递减一个是不是这个意思

gaics 发表于 2020-9-28 18:41:05

江南十笑 发表于 2020-9-28 18:35
就是从选择集中删除一个图元 后面图元的i值会自动往前递减一个是不是这个意思

是这样的。

江南十笑 发表于 2020-9-28 18:56:04

好的谢谢      
页: [1]
查看完整版本: 下面代码哪个地方有问题