采集多段线三维点程序（LISP）

hzh2000 · 发表于 2006-7-9 18:31:16

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

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

x

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                               ;;
;;    采集多段线三维点程序    ;;
;;                               ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:print_point(/ defun_dir)
  (setq ss (ssget ":s"))
  (princ "\n")
  (if (null defun_dir)(setq defun_dir (getvar "DWGPREFIX")))
  (setq fname (getfiled "请输入文件名: ----------MYCAD V3,HZH2000,2004.4.16---------" defun_dir "txt" 1))
(if  fname
  (progn
  (setq fdesc (open fname "w"))
  (setq defun_dir (vl-filename-directory fname))
  ;(princ  defun_dir)
  (setq z1 (vl-filename-base fname))
  (setq z2 (atof (substr z1 1 (- (strlen z1) 2))))
  (setq z3 (substr z1  (- (strlen z1) 1) 2))

  (setq en (ssname ss 0))
  (setq ed (entget en))
  (setq ename (cdr (assoc '0 ed)))
  (setq id 0)
  (while id
(setq point (cdr (assoc '10 ed)))
(setq ed (subst '(-99 0 0 0 ) (assoc '10 ed) ed))
(if (null point) (setq id nil))
(if point
   (progn
   (setq x (car point))
   (setq y (nth 1 point))
   (setq z (nth 2 point))
   (if (null z) (setq z z2 ))
      (if (= (strcase z3) "WL")
      (write-line (strcat (rtos x 2 2) " " (rtos y 2 2) " " (rtos z 2 2)) fdesc)
      (write-line (strcat (rtos x 2 2) " " (rtos z 2 2) " " (rtos y 2 2)) fdesc)
   )
   )
)
  )
(close fdesc)
)
)
)

songshilei · 发表于 2012-11-20 16:04:10

怎么用啊？

		自动登录	找回密码
密码			注册

通知

[原创] 采集多段线三维点程序（LISP）

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块