【求助】框选内的区域，交点的计算方法（或者是插入）（fixnump错误）

qcw911

各位高手
如何lisp在框选的里面生成k层的红色方块呢
白色为框选范围
网格线之间的距离是1000
我的想法是框选后
根据距离可以很简单的在框里面计算出各点
然后插入块就行了

我是刚学的新手
因为每次框选的范围不同
所以生成的点的个数不同
对于这样的情况我很茫然
就是N个点
这种情况怎么处理呢
请各位高手指点一下
帮帮忙

Gu_xl

回复 qcw911 的帖子

回车结束命令！
(vl-load-com)自行添加即是！
红框仅仅是提示框！程序运行正常！

chenbh2

Gu_xl 发表于 2011-4-19 14:07
回复 qcw911 的帖子
框选交点画框 By Gu_xl 2011.04
**** 本内容被作者隐藏 ****

G版您好！运行了“与线相交交点打断”
程序后再次运行，出现 函数错误: #<safearray..
而其他程序不会出现问题！麻烦回复，谢谢！！

不想多说

总是在思路卡壳的时候来到明经，搜索G版回复的帖子，然后解决问题……哈哈哈

qcw911

(defun c:tt()
  (setq pt1(getpoint"\n第一点:"))
  (setq pt3(getpoint pt1"\n第二点:"))
  (setq pt1x (car pt1))
  (setq pt1y (cadr  pt1))
  (setq pt3x (car pt3))
  (setq pt3y (cadr  pt3))
  (setq pt2 (list pt3x pt1y))
  (setq pt4 (list pt1x pt3y))
;;;  (setq mun (- pt1y pt3y))
(setq num (distance pt1 pt4))
  (if (= 0 (rem num 910))
    (setq w 910)
    (setq w 1000)
    )
  (setq ang (angle pt1 pt4))
  (setq nn (/ num w))
  (setq nn2 nn)
  (repeat nn
       (setq bas pt1)
           (repeat nn2
              (command "-INSERT" "box" bas 20 "" "")
              (setq bas (polar bas ang w))
             )
       (setq pt1 (polar pt1  ang  w))
    )

(princ)
)



fixnump: 2.0 这个错误什么意思？
大家看看这段程序 出现为什么问题了呢？

Gu_xl

回复 qcw911 的帖子
框选交点画框 By Gu_xl 2011.04

1. ;;;计算曲线交点
   
2. (defun Curveinters (en1 en2 / pl pts)
   
3.   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
   
4.   (while pl
   
5.     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
   
6.    pl (cdr (cdr (cdr pl)))
   
7.    )
   
8.     )
   
9. pts
   
10.   )
    
11. ;;;曲线选择集交点
    
12. (defun ssinters (ss / pts en1 en2)
    
13.   (while (> (sslength ss) 1)
    
14.     (setq en1 (ssname ss 0))
    
15.     (ssdel en1 ss)
    
16.     (setq n (sslength ss))
    
17.     (repeat n
    
18.       (setq en2 (ssname ss (setq n (1- n))))
    
19.       (setq pts (append pts (Curveinters en1 en2)))
    
20.       )
    
21.     )
    
22.   pts
    
23.   )
    
24. ;;;画框
    
25. (defun drawbox (pt d / r en ang)
    
26.   (setq en (ssget pt '((0 . "*line"))))
    
27.   (setq en (ssname en 0))
    
28.   (setq ang (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (setq pt (vlax-curve-getclosestpointto en pt)))))))
    
29.   (setq r (* d (sqrt 2)))
    
30.   ;;此处也可改插入框的图块
    
31.   (command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )
    
32.   (command "rotate" (entlast) "" pt (/ (* 180 ang) pi))
    
33.   )
    
34. ;;;使用实例
    
35. (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho)
    
36.   (setq os (getvar "osmode"))
    
37.   (setq cmdecho (getvar "cmdecho"))
    
38.   (setvar "osmode" 0)
    
39.   (setvar "cmdecho" 0)
    
40.   (setq d (getreal "\n插入框大小<1.0>"))
    
41.   (if (null d) (setq d 1.))
    
42.   (while (and
    
43.            (setq p1 (getpoint "\n选择图框左下角："))
    
44.            (setq p2 (GETCORNER p1 "\n选择图框左下角："))
    
45.            )
    
46.     (setq minX (apply 'min (mapcar 'car (list p1 p2)))
    
47.           minY (apply 'min (mapcar 'cadr (list p1 p2)))
    
48.           maxX (apply 'max (mapcar 'car (list p1 p2)))
    
49.           maxY (apply 'max (mapcar 'cadr (list p1 p2)))
    
50.           )
    
51.     (grvecs (list 1 (list minx miny) (list maxx miny)
    
52.                   1 (list maxx miny) (list maxx maxy)
    
53.                   1 (list maxx maxy) (list minx maxy)
    
54.                   1 (list minx maxy) (list minx miny)
    
55.                   )
    
56.             )
    
57.     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))
    
58.     (if ss
    
59.       (progn
    
60.         (setq pts (ssinters ss))
    
61.         (if pts
    
62.           (foreach pt pts
    
63.             (if (and (>= maxX (car pt) minX)
    
64.                      (>= maxY (cadr pt) minY)
    
65.                      )
    
66.               (drawbox pt d)
    
67.               )
    
68.             )
    
69.           )
    
70.         )
    
71.       )
    
72.     (princ "\n ***回车键结束***")
    
73.     )
    
74. (setvar "osmode" os)
    
75.   (setvar "cmdecho" cmdecho)
    
76.   (princ)
    
77.   )
    

;;;计算曲线交点<br /> (defun Curveinters (en1 en2 / pl pts)<br />   (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))<br />   (while pl<br />     (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))<br />    pl (cdr (cdr (cdr pl)))<br />    )<br />     )<br /> pts<br />   )<br /> ;;;曲线选择集交点<br /> (defun ssinters (ss / pts en1 en2)<br />   (while (> (sslength ss) 1)<br />     (setq en1 (ssname ss 0))<br />     (ssdel en1 ss)<br />     (setq n (sslength ss))<br />     (repeat n<br />       (setq en2 (ssname ss (setq n (1- n))))<br />       (setq pts (append pts (Curveinters en1 en2)))<br />       )<br />     )<br />   pts<br />   )<br /> ;;;画框<br /> (defun drawbox (pt d / r en ang)<br />   (setq en (ssget pt '((0 . "*line"))))<br />   (setq en (ssname en 0))<br />   (setq ang (angle pt (mapcar '+ pt (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (setq pt (vlax-curve-getclosestpointto en pt)))))))<br />   (setq r (* d (sqrt 2)))<br />   ;;此处也可改插入框的图块<br />   (command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )<br />   (command "rotate" (entlast) "" pt (/ (* 180 ang) pi))<br />   )<br /> ;;;使用实例<br /> (defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os cmdecho)<br />   (setq os (getvar "osmode"))<br />   (setq cmdecho (getvar "cmdecho"))<br />   (setvar "osmode" 0)<br />   (setvar "cmdecho" 0)<br />   (setq d (getreal "\n插入框大小<1.0>"))<br />   (if (null d) (setq d 1.))<br />   (while (and<br />            (setq p1 (getpoint "\n选择图框左下角："))<br />            (setq p2 (GETCORNER p1 "\n选择图框左下角："))<br />            )<br />     (setq minX (apply 'min (mapcar 'car (list p1 p2)))<br />           minY (apply 'min (mapcar 'cadr (list p1 p2)))<br />           maxX (apply 'max (mapcar 'car (list p1 p2)))<br />           maxY (apply 'max (mapcar 'cadr (list p1 p2)))<br />           )<br />     (grvecs (list 1 (list minx miny) (list maxx miny)<br />                   1 (list maxx miny) (list maxx maxy)<br />                   1 (list maxx maxy) (list minx maxy)<br />                   1 (list minx maxy) (list minx miny)<br />                   )<br />             )<br />     (setq ss (ssget "c" p1 p2 '((0 . "*line"))))<br />     (if ss<br />       (progn<br />         (setq pts (ssinters ss))<br />         (if pts<br />           (foreach pt pts<br />             (if (and (>= maxX (car pt) minX)<br />                      (>= maxY (cadr pt) minY)<br />                      )<br />               (drawbox pt d)<br />               )<br />             )<br />           )<br />         )<br />       )<br />     (princ "\n ***回车键结束***")<br />     )<br /> (setvar "osmode" os)<br />   (setvar "cmdecho" cmdecho)<br />   (princ)<br />   )<br />

qcw911

回复 Gu_xl 的帖子

版主
是不是少了个(vl-load-com)
我加了
但是好像还有点问题
输入命令后
不停让我选择图框左下角
结果是出现红色的图框
移动鼠标后
图框消失了
没有插入小方块
（drawbox ）好像没有执行
不知道是为什么


(defun Curveinters (en1 en2 / pl pts)
  (setq pl  (vlax-invoke (vlax-ename->vla-object en2) 'IntersectWith (vlax-ename->vla-object en1) acExtendNone))
  (while pl
    (setq pts (append pts (list (list (car pl) (cadr pl) (caddr pl))))
   pl (cdr (cdr (cdr pl)))
   )
    )
pts
  )
(defun ssinters (ss / pts en1 en2)
  (while (> (sslength ss) 1)
    (setq en1 (ssname ss 0))
    (ssdel en1 ss)
    (setq n (sslength ss))
    (repeat n
      (setq en2 (ssname ss (setq n (1- n))))
      (setq pts (append pts (Curveinters en1 en2)))
      )
    )
  pts
  )
(defun drawbox (pt d / r )
  (setq r (* d (sqrt 2)))
  (command "rectang" (polar pt (* pi 1.25) r) (polar pt (* pi 0.25) r ) )
  )
(defun c:tt(/ p1 p2 d minX minY maxX maxY pt pts p1 p2 ss os)
  (vl-load-com)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq d (getreal "\n插入框大小<1.0>"))
  (if (null d) (setq d 1.))
  (while (and
           (setq p1 (getpoint "\n选择图框左下角"))
           (setq p2 (GETCORNER p1 "\n选择图框左下角"))
           )
    (setq minX (apply 'min (mapcar 'car (list p1 p2)))
          minY (apply 'min (mapcar 'cadr (list p1 p2)))
          maxX (apply 'max (mapcar 'car (list p1 p2)))
          maxY (apply 'max (mapcar 'cadr (list p1 p2)))
          )
    (grvecs (list 1 (list minx miny) (list maxx miny)
                  1 (list maxx miny) (list maxx maxy)
                  1 (list maxx maxy) (list minx maxy)
                  1 (list minx maxy) (list minx miny)
                  )
            )
    (setq ss (ssget "c" p1 p2 '((0 . "*line"))))
    (if ss
      (progn
        (setq pts (ssinters ss))
        (if pts
          (foreach pt pts
            (if (and (>= maxX (car pt) minX)
                     (>= maxY (cadr pt) minY)
                     )
              (drawbox pt d)
              )
            )
          )
        )
      )
    )
(setvar "osmode" os)
  (princ)
  )

zsw23

间接的解决了我的问题

daiguafan

呵呵，很受启发啊
谢谢斑竹

jfxia

          我想做个自动线性标注的程序，希望有用，谢

yan19851204

版主能否改成插入圆或插入块啊

【KAIXIN】

Gu_xl 发表于 2011-4-19 14:07
回复 qcw911 的帖子

版主，可否弄成批量插块呢？

比如：批量圆心点插块