求助：一个关于选取直线获得端点坐标的循环算法

hlzhong

请教高手：通过下列lisp程序可获取一条直线的两端点坐标，（其中每条直线视作一个实体），那么该如何编制一个循环算法，不停地调用该命令从而得到一个三维线框模型（譬如一个正方体的各棱组成的线框模型）各个顶点的坐标值而不会出现各顶点坐标重复出现的情况，恳请赐教。


(defun c:glp(/ ent el p1 p2)
   (setq ent (car (entsel "\n请选取直线：")))  ;;ent 为实体名
   (if ent (progn                  
       (setq el (entget ent))
       (if (equal (cdr (assoc 0 el)) "LINE")
         (progn
           (setq p1 (cdr (assoc 10 el)))    ;;p1,p2分别为直线的起、终点
           (setq p2 (cdr (assoc 11 el)))
           (princ "\n")
           (princ "端点1的坐标")
           (princ  p1)
           (princ "\n")
           (princ "端点2的坐标")
           (princ  p2)
          )(progn
           (princ "\n选择的不是直线")
       ))
    )(progn
     (princ "\n没有选择到直线。")
   ))
   (princ)
)

龙龙仔

(defun C:TT (/ SS N NN ENT TMP PT_LIST)
  (setq SS (entsel "\n选取正方体<三维线框模型>: "))
  (princ "\n")
  (command "_.COPY" (car SS) "" "0,0" "@")
  (command "_.EXPLODE" (entlast))
  (setq SS (ssget ""))
  (setq N 0)
  (repeat (sslength SS)
    (setq ENT (entget (ssname SS N)))
    (setq NN 0)
    (repeat 4
      (if (not (member (setq TMP (cdr (assoc (+ 10 NN) ENT))) PT_LIST)
          )
        (setq PT_LIST (append PT_LIST (list TMP)))
      )
      (setq NN (1+ NN))
    )
    (setq N (1+ N))
  )
  (command "_.ERASE" SS "")
  PT_LIST
)

hlzhong

如果针对三维线框模型，运行后提示：该对象无法分解；如果针对三维实体模型，则提示如下：
命令: TT
选取正方体<三维线框模型>:
_.COPY
选择对象:   找到 1 个
选择对象: 指定基点或位移，或者 [重复(M)]: 0,0 指定位移的第二点或
<用第一点作位移>: @
命令: _.EXPLODE
选择对象:
该对象无法分解。
未找到对象。
选择对象: _.ERASE
*无效选择*
需要点或 Last/ALL/Group
; 错误: 函数被取消
选择对象: *取消*
命令: e
ERASE

龙龙仔

我畫的三维线框模型是用下列指令,你指的三维线框模型是甚麼???

指令: _ai_box
起始設定...  3D 物件已被載入.
指定角點 - 矩形體:
指定長度 - 矩形體:
指定矩形體的寬度或 [立方體(C)]:
指定高度 - 矩形體:
指定矩形體繞著 Z 軸旋轉的角度或 [參照(R)]:0

hlzhong

嗯，对于_ai_box创建的却是有效，但我是用line命令结合vpoint创建的三维线框模型，其中每条直线都可视作一个实体，不知如何能得到他们的顶点坐标。下附一个我作出的三维线框模型：

龙龙仔

;;注意:只处理"polyline,line,lwpolyline"直线,含ARC的线不处理
(defun C:TT (/ SS SS1 N N1 NN ENT CHECK TMP PT_LIST)

  (defun DO_IT1        ()
    (if        (not
          (member (setq TMP (cdr (assoc 10 (entget ENT)))) PT_LIST)
        )
      (setq PT_LIST (append PT_LIST (list TMP)))
    )
    (if        (not
          (member (setq TMP (cdr (assoc 11 (entget ENT)))) PT_LIST)
        )
      (setq PT_LIST (append PT_LIST (list TMP)))
    )
  )

  (setq SS (ssget '((0 . "polyline,line,lwpolyline"))))
  (setq PT_LIST '())
  (setq N 0)
  (repeat (sslength SS)
    (setq ENT (ssname SS N))
    (setq CHECK (cdr (assoc 100 (reverse (entget ENT)))))
    (cond
      ((= CHECK "AcDbPolygonMesh")
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget ""))
       (setq N1 0)
       (repeat (sslength SS1)
         (setq ENT (entget (ssname SS1 N1)))
         (setq NN 0)
         (repeat 4
           (if
             (not (member (setq TMP (cdr (assoc (+ 10 NN) ENT))) PT_LIST)
             )
              (setq PT_LIST (append PT_LIST (list TMP)))
           )
           (setq NN (1+ NN))
         )
         (setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      ((OR(= CHECK "AcDb3dPolyline")
          (= (CDR (ASSOC 0 (ENTGET ENT))) "OLYLINE")
          (= (CDR (ASSOC 0 (ENTGET ENT))) "LWPOLYLINE"))
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget ""))
       (setq N1 0)
       (repeat (sslength SS1)
         (setq ENT (ssname SS1 N1))
         (DO_IT1)
         (setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      (t
       (DO_IT1)
      )
    )
    (setq N (1+ N))
  )
  PT_LIST
)

hlzhong

请大侠指导：我想做一个自动生成透视图的程序(如下)，其中第(1)部分为龙大侠给出的立方体顶点坐标循环选择算法(单独试过，没问题)，第(2)部分为变量赋值，第(3)部分为透视投影算法(此算法没什么问题)，第(4)部分为最后一步，将生成的各透视点相连构成透视图。???不知下列程序哪处不对，运行后提示选择实体，选择后却报错："错误: 参数类型错误: numberp: nil" ,不知如何修改，还请赐教，谢谢～～ 另：程序中对立方体的要求是三维线框模型，最好是经过旋转后(这样生成的透视图效果较好)的。


(defun c:project(/
               X  Y  Z         ;视点坐标
               X1 Y1 Z1 X2 Y2 Z2 X3 Y3 Z3 X4 Y4 Z4
               X5 Y5 Z5 X6 Y6 Z6 X7 Y7 Z7 X8 Y8 Z8  
                               ;立方体的顶点坐标
               x1  y1  z1  x2  y2  z2 x3  y3  z3  x4  y4  z4
               x5  y5  z5  x6  y6  z6  x7  y7  z7 x8  y8  z8     
                               ;各点的投影点坐标

               a1  a2  a3  a4  
               a5  a6  a7  a8  ;各点的投影点对)


      (setq X 230.0)
      (setq Y 320)
      (setq Z 80.0)    ;指定透视点坐标



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;(1)以下为龙大侠的提取立方体各顶点坐标的循环算法;;

   (defun TT (/ SS SS1 N N1 NN ENT CHECK TMP PT_LIST)

  (defun DO_IT1 ()
    (if (not
  (member (setq TMP (cdr (assoc 10 (entget ENT)))) PT_LIST)
)
      (setq PT_LIST (append PT_LIST (list TMP)))
    )
    (if (not
  (member (setq TMP (cdr (assoc 11 (entget ENT)))) PT_LIST)
)
      (setq PT_LIST (append PT_LIST (list TMP)))
    )
  )

  (setq SS (ssget '((0 . "polyline,line,lwpolyline"))))
  (setq PT_LIST '())
  (setq N 0)
  (repeat (sslength SS)
    (setq ENT (ssname SS N))
    (setq CHECK (cdr (assoc 100 (reverse (entget ENT)))))
    (cond
      ((= CHECK "AcDbPolygonMesh")
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget ""))
       (setq N1 0)
       (repeat (sslength SS1)
(setq ENT (entget (ssname SS1 N1)))
(setq NN 0)
(repeat 4
   (if
     (not (member (setq TMP (cdr (assoc (+ 10 NN) ENT))) PT_LIST)
     )
      (setq PT_LIST (append PT_LIST (list TMP)))
   )
   (setq NN (1+ NN))
)
(setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      ((OR(= CHECK "AcDb3dPolyline")
          (= (CDR (ASSOC 0 (ENTGET ENT))) "OLYLINE")
          (= (CDR (ASSOC 0 (ENTGET ENT))) "LWPOLYLINE"))
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget ""))
       (setq N1 0)
       (repeat (sslength SS1)
(setq ENT (ssname SS1 N1))
(DO_IT1)
(setq N1 (1+ N1))
       )
       (command "_.ERASE" SS1 "")
      )
      (t
       (DO_IT1)
      )
    )
    (setq N (1+ N))
  )
  PT_LIST
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(2)以下程序将上述得到的点表中的坐标值分别赋给变量X1,Y1,Z1,X2....Z8;
  
       (setq PT (TT))
  
       (setq X1 (car (nth 0 PT)))
       (setq Y1 (cdr (nth 0 PT)))
       (setq Z1 (caddr (nth 0 PT)))

       (setq X2 (car (nth 1 PT)))
       (setq Y2 (cdr (nth 1 PT)))
       (setq Z2 (caddr (nth 1 PT)))

       (setq X3 (car (nth 2 PT)))
       (setq Y3 (cdr (nth 2 PT)))
       (setq Z3 (caddr (nth 2 PT)))

        (setq X4 (car (nth 3 PT)))
        (setq Y4 (cdr (nth 3 PT)))
        (setq Z4 (caddr (nth 3 PT)))

        (setq X5 (car (nth 4 PT)))
        (setq Y5 (cdr (nth 4 PT)))
        (setq Z5 (caddr (nth 4 PT)))

        (setq X6 (car (nth 5 PT)))
        (setq Y6 (cdr (nth 5 PT)))
        (setq Z6 (caddr (nth 5 PT)))

        (setq X7 (car (nth 6 PT)))
        (setq Y7 (cdr (nth 6 PT)))
        (setq Z7 (caddr (nth 6 PT)))

        (setq X8 (car (nth 7 PT)))
        (setq Y8 (cdr (nth 7 PT)))
        (setq Z8 (caddr (nth 7 PT)))
  
  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(3)以下程序为透视投影算法，将上述的各顶点坐标值带入以下方程;;

      (setq x1(- X1 (/ (* Y1 (- X1 X)) (- Y1 Y))))
      (setq x2(- X2 (/ (* Y2 (- X2 X)) (- Y2 Y))))
      (setq x3(- X3 (/ (* Y3 (- X3 X)) (- Y3 Y))))
      (setq x4(- X4 (/ (* Y4 (- X4 X)) (- Y4 Y))))
      (setq x5(- X5 (/ (* Y5 (- X5 X)) (- Y5 Y))))
      (setq x6(- X6 (/ (* Y6 (- X6 X)) (- Y6 Y))))
      (setq x7(- X7 (/ (* Y7 (- X7 X)) (- Y7 Y))))
      (setq x8(- X8 (/ (* Y8 (- X8 X)) (- Y8 Y))))

      (setq z1 (- Z1 (/ (* Y1 (- 80 Z1)) (- 320 Y1))))
      (setq z2 (- Z2 (/ (* Y2 (- 80 Z2)) (- 320 Y2))))
      (setq z3 (- Z3 (/ (* Y3 (- 80 Z3)) (- 320 Y3))))
      (setq z4 (- Z4 (/ (* Y4 (- 80 Z4)) (- 320 Y4))))
      (setq z5 (- Z5 (/ (* Y5 (- 80 Z5)) (- 320 Y5))))
      (setq z6 (- Z6 (/ (* Y6 (- 80 Z6)) (- 320 Y6))))
      (setq z7 (- Z7 (/ (* Y7 (- 80 Z7)) (- 320 Y7))))
      (setq z8 (- Z8 (/ (* Y8 (- 80 Z8)) (- 320 Y8))))

  
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;(4)构造点表，描出透视点，连接相应的点，构成透视图;;;;;
      
      (setq a1(list x1 z1))
      (setq a2(list x2 z2))
      (setq a3(list x3 z3))
      (setq a4(list x4 z4))
      (setq a5(list x5 z5))
      (setq a6(list x6 z6))
      (setq a7(list x7 z7))
      (setq a8(list x8 z8))

   
      (command "line"  a1 a2 "")
      (command "line"  a2 a3 "")
      (command "line"  a3 a4 "")
      (command "line"  a4 a1 "")
  
      (command "line"  a5 a6 "")
      (command "line"  a6 a7 "")
      (command "line"  a7 a8 "")
      (command "line"  a8 a5 "")

      (command "line"  a2 a6 "")
      (command "line"  a1 a5 "")
      (command "line"  a3 a7 "")
      (command "line"  a4 a8 "")

    )

龙龙仔

hlzhong

hlzhong

多谢龙大侠，错误已排除。还想讨论请教一下你的循环选择程序中如果想让选择到的三维线框模型再得到其坐标点值后将其删除（擦除线框模型），不知erase语句加在何处好？ 是加在(setq NN (1+ NN))
)    (command "Erase"(entlast))
(setq N1 (1+ N1))   处吗？