[求助]：帮忙指出毛病

playboy · 发表于 2004-1-12 00:35:57

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

这个程序我也不知道问题出在哪里
其实一个错误标出一个圆圈就可以了
可是我这个却是总点数的二倍
请帮忙指出一下问题的所在

(defun c:chd (/ EN EN1 ENTD ENTD1 M N POI POILEN ZB ZB1)
 (prompt "\n数据正在处理中请稍候...")
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)
 (command "undo" "begin" )
 (command "layer" "new" "tmp" "set" "tmp" "")
 (setq poi (ssget "X" (list (CONS 0 "insert"))))
 (setq poilen (sslength poi) )
 (setq n 0)
 (while (< n poilen )
 (progn
 (setq en (ssname poi n))
 (setq entd (entget en))
 (setq zb (cdr (assoc 10 entd)))

 (setq m 1)
 (while (< m poilen )
(progn
(setq en1 (ssname poi m))
 (setq entd1 (entget en1))
 (setq zb1 (cdr (assoc 10 entd1)))
 (if (not (equal zb1 zb))
(progn
 (command "circle" zb "3")
 )
)
 (setq m (+ 1 m ))
 )
)
 (setq n (+ 1 n))
)
 )
 (command "undo" "end" )
 )

eachy · 发表于 2004-1-12 12:50:21

两次 While 套在一起自然不等了

playboy · 发表于 2004-1-12 14:45:59

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

斑竹帮帮忙解决一下好吗

eachy · 发表于 2004-1-13 01:24:22

最初由 playboy 发布
[B]斑竹帮帮忙解决一下好吗 [/B]

可能少一个

[php]
(defun c:chd (/ ss n l1 pinst oldos oldlay l2 ll1)
(prompt "\n数据正在处理中请稍候...")
(setq oldos (getvar "osmode"))
(setq oldlay (getvar "clayer"))
(command "undo" "begin")
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "layer" "make" "tmp" "")
(setq ss (ssget "x" (list (cons 0 "insert"))))
(setq n -1
l2 '()
)
(repeat (sslength ss)
(setq pinst (cdr (assoc 10 (entget (ssname ss (setq n (1+ n)))))))
(setq l2 l1)
(while (and (setq ll1 (car l2))
(not (equal pinst (car ll1) 0.0001))
)
(setq l2 (cdr l2))
)
(setq l1 (if ll1
(subst (append ll1 (list pinst)) ll1 l1)
(cons (list pinst) l1)
)
)
)
(mapcar '(lambda (x)
(if (> (length x) 1)
(command ".circle" (car x) "3")
)
)
l1
)
(command "undo" "end")
(setvar "osmode" oldos)
(setvar "clayer" oldlay)
(princ)
)[/php]

[php] 
(defun c:chd (/ ss n l1 pinst oldos oldlay l2 ll1) 
  (prompt "\n数据正在处理中请稍候...") 
  (setq oldos (getvar "osmode")) 
  (setq oldlay (getvar "clayer")) 
  (command "undo" "begin") 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (command "layer" "make" "tmp" "") 
  (setq ss (ssget "x" (list (cons 0 "insert")))) 
  (setq        n  -1 
        l2 '() 
  ) 
  (repeat (sslength ss) 
    (setq pinst (cdr (assoc 10 (entget (ssname ss (setq n (1+ n))))))) 
    (setq l2 l1) 
    (while (and        (setq ll1 (car l2)) 
                (not (equal pinst (car ll1) 0.0001)) 
           ) 
      (setq l2 (cdr l2)) 
    ) 
    (setq l1 (if ll1 
               (subst (append ll1 (list pinst)) ll1 l1) 
               (cons (list pinst) l1) 
             ) 
    ) 
  ) 
  (mapcar '(lambda (x) 
             (if (> (length x) 1) 
               (command ".circle" (car x) "3") 
             ) 
           ) 
          l1 
  ) 
  (command "undo" "end") 
  (setvar "osmode" oldos) 
  (setvar "clayer" oldlay) 
  (princ) 
)[/php]

融春 · 发表于 2004-1-13 02:37:56

我看不懂，是结构上计算用的自编计算用的软件吗
，现在想去考试，总么感觉都是漠生的，不要太打击信心才好

playboy · 发表于 2004-1-13 11:24:20

to eachy

斑竹你这句好象是有问题

(mapcar '(lambda (x)
         (if (not (equal x pinst 0.0001))
      (command "circle" x "3")
         )
      )
      ll
)
  )

这个值它取不出来  X  值

eachy · 发表于 2004-1-13 11:55:41

最初由 playboy 发布
[B]to eachy

斑竹你这句好象是有问题

(mapcar '(lambda (x)
         (if (not (equal x pinst 0.0001))
      (command "circle" x "3")
         )
      )
      ll
)
  )

这?.. [/B]

ll 是块的插入点表，X 是插入点

playboy · 发表于 2004-1-13 12:08:15

对呀就是这个 X 取出的值为nil

所以圆圈画不上

eachy · 发表于 2004-1-13 12:18:34

最初由 playboy 发布
[B]对呀就是这个 X 取出的值为nil

所以圆圈画不上 [/B]

发个测试图上来

playboy · 发表于 2004-1-13 13:39:52

测试图

eachy · 发表于 2004-1-13 14:20:04

最初由 playboy 发布
[B]测试图 [/B]

请说明下程序的作用，图上的只有圆圈是块，程序中的圆圈是在外面再套一个？

playboy · 发表于 2004-1-13 14:36:42

在圆圈重合的地方做一个标记
注记可以不考虑
这个图的每一个圆圈都是重合的用我自己编的可以到目的可是特别满

eachy · 发表于 2004-1-13 18:46:03

最初由 playboy 发布
[B]在圆圈重合的地方做一个标记
注记可以不考虑
这个图的每一个圆圈都是重合的用我自己编的可以到目的可是特别满 [/B]

上面的程序已更改，下面的是VLisp混合方法，速度可能快些，当然上面的command用entmake替换也可以，关键是选择集的处理方法不同。

再次优化，将生成圆放到了循环内部

[php]
(vl-load-com)
(defun c:chd (/ ss l1 pinst oldos oldlay l2 ll1 doc ll2)
(prompt "\n数据正在处理中请稍候...")
(setq oldos (getvar "osmode")
oldlay (getvar "clayer")
doc (vlax-get-property (vlax-get-acad-object) 'activedocument)
)
(vla-startundomark doc)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "layer" "make" "tmp" "")
(setq ss (ssget (list (cons 0 "insert"))))
(setq l2 '())
(vlax-for item (vla-get-activeselectionset doc)
(setq pinst (safearray-value
(variant-value (vla-get-insertionpoint item))
)
)
(setq l2 l1)
(while (and (setq ll1 (car l2))
(not (equal pinst (car ll1) 0.0001))
)
(setq l2 (cdr l2))
)
(if (and ll1 (not (member 1 ll1)))
(progn (entmake (list '(0 . "circle")
(cons 10 pinst)
'(40 . 3.)
)
)
(setq ll2 (append ll1 '(1)))
)
)
(setq l1 (if ll1
(subst (append (list pinst)
(if ll2
ll2
ll1
)
)
ll1
l1
)
(cons (list pinst) l1)
)
)
)
(vla-endundomark doc)
(setvar "osmode" oldos)
(setvar "clayer" oldlay)
(princ)
)[/php]

[php] 
(vl-load-com) 
(defun c:chd (/ ss l1 pinst oldos oldlay l2 ll1 doc ll2) 
  (prompt "\n数据正在处理中请稍候...") 
  (setq        oldos  (getvar "osmode") 
        oldlay (getvar "clayer") 
        doc    (vlax-get-property (vlax-get-acad-object) 'activedocument) 
  ) 
  (vla-startundomark doc) 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (command "layer" "make" "tmp" "") 
  (setq ss (ssget (list (cons 0 "insert")))) 
  (setq l2 '()) 
  (vlax-for item (vla-get-activeselectionset doc) 
    (setq pinst        (safearray-value 
                  (variant-value (vla-get-insertionpoint item)) 
                ) 
    ) 
    (setq l2 l1) 
    (while (and        (setq ll1 (car l2)) 
                (not (equal pinst (car ll1) 0.0001)) 
           ) 
      (setq l2 (cdr l2)) 
    ) 
    (if        (and ll1 (not (member 1 ll1))) 
      (progn (entmake (list '(0 . "circle") 
                            (cons 10 pinst) 
                            '(40 . 3.) 
                      ) 
             ) 
             (setq ll2 (append ll1 '(1))) 
      ) 
    ) 
    (setq l1 (if ll1 
               (subst (append (list pinst) 
                              (if ll2 
                                ll2 
                                ll1 
                              ) 
                      ) 
                      ll1 
                      l1 
               ) 
               (cons (list pinst) l1) 
             ) 
    ) 
  ) 
  (vla-endundomark doc) 
  (setvar "osmode" oldos) 
  (setvar "clayer" oldlay) 
  (princ) 
)[/php]

playboy · 发表于 2004-1-14 08:28:57

斑竹又没有lisp的不用vlisp
这个有一点看不懂
不过还是要谢谢您
问题是解决了

eachy · 发表于 2004-1-14 12:42:25

最初由 playboy 发布
[B]斑竹又没有lisp的不用vlisp
这个有一点看不懂
不过还是要谢谢您
问题是解决了 [/B]

4 楼的为纯Lisp，你可以参照最后那个将画圆部分移至 repeat 内，当然不修改也可以使用的。

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

[求助]：帮忙指出毛病

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块