明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1992|回复: 1

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

[复制链接]
发表于 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 ""))
       (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))
  )
   
(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 | 显示全部楼层
坐标转换贝
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 17:46 , Processed in 0.175328 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表