hlzhong 发表于 2003-6-4 14:41:00

请教高手,如何修改该程序?

下列程序是以前的一个程序,可以通过在CAD中交互框选一空间平面体而返回一点表(表中为各顶点坐标值),而现在我为了在各点坐标值中找一个z坐标最小(即最靠后)的点,并将该空间平面体从该点移到原点,所以在程序最后加了2条语句:(setq A (car (vl-sort PT_LIST '(lambda (z1 z2)(< (caddr z1)(caddr z2))))) )
(command "move" "all" "" A'(0 0 0) "")   
) 这样可以实现该形体按要求移动到原点,但是出现新的问题是:我希望修改后的程序象原来的程序那样能返回一个点表(为 移动到原点后各顶点坐标值的点表)以便后续程序能继续从中读取各顶点的坐标值。不知该对下述程序进行如何修改?(注:我只希望程序执行初进行一次选择(框选),否则就可以另外操作一次再调用一次原来的程序得到移动后的形体顶点了。)



(defun C:tts (/ SS SS1 N N1 NN ENT CHECK TMP PT_LIST A )
   
(command "explode" "all" "")
(command "explode" "all" "")
(command "explode" "all" "")

   
(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 "P"))
       (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))) "POLYLINE")
          (= (CDR (ASSOC 0 (ENTGET ENT))) "LWPOLYLINE"))
       (command "_.COPY" ENT "" "0,0" "@")
       (command "_.EXPLODE" (entlast))
       (setq SS1 (ssget "P"))
       (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))
)
   
(setq A (car (vl-sort PT_LIST '(lambda (z1 z2)(< (caddr z1)(caddr z2))))) )
(command "move" "all" "" A'(0 0 0) "")   
)

无痕 发表于 2003-9-27 22:23:00

坐标转换贝
页: [1]
查看完整版本: 请教高手,如何修改该程序?