zym.lsp

acad读取图形信息的源代码

(defun c:zym ()
  (setq	x1 nil
	y1 nil
	hi nil
	h nil
	cxj nil
	jhj nil
	i nil
	k nil
	fn nil
	filename nil
	l nil
	JA nil
	OK nil
  ) ;_ 结束setq
  (setq	p1 nil
	p2 nil
	p3 nil
	p4 nil
	point nil
	point1 nil
	D nil
	n nil
	m nil
	z nil
	y nil
  ) ;_ 结束setq
  (setq OK 1)
  (setq filename (getfiled "存储数据文件" "" "dat" 1))
  (if (= nil filename)
    (exit)
  )
  (while (= nil hi)
    (setq hi (getreal "\n请输入水位改正常数:"))
  ) ;_ 结束while
  (while (= nil D)
    (setq D (getreal "\n请输入水深文本注记的高度:"))
  ) ;_ 结束while
  (while (= nil JA)
    (setq JA (getangle "\n请输入水深文本注记的倾斜角度:"))
  ) ;_ 结束while
  (while (= nil l)
    (setq l
	   (getint
	     "\n请选择成图环境 [1]CASS3.0; [2]CASS3.0转CASS4.0; [3]CASS4.0:"
	   ) ;_ 结束getint
    ) ;_ 结束setq
  ) ;_ 结束while
  (cond	((= l 1)
	 (setq l 8)
	)
	((= l 2)
	 (setq l 11)
	)
	((= l 3)
	 (setq l 10)
	)
  )
  (setq La (* (* D 1) (sin JA)))
  (setq Lb (* (* D 1) (cos JA)))
  (setq L1a (* (* D 2.8) (sin JA)))
  (setq L1b (* (* D 2.8) (cos JA)))
  (setq L2a (* (* D 1.2) (sin JA)))
  (setq L2b (* (* D 1.2) (cos JA)))
  (setq L3a (* (* D 2.2) (sin JA)))
  (setq L3b (* (* D 2.2) (cos JA)))
  (setq fn (open filename "w"))
  (setq	cxj (ssget
	      (list (cons 8 "GCD") (cons 0 "INSERT"))
	    ) ;_ 结束ssget
  ) ;_ 结束setq
  (prompt "请稍后，正在进行数据转换.......\n")
  (setq n (sslength cxj))
  (cond	((/= n 0)
    ((setq m (rtos n 2 0))
    (write-line m fn)
    (setq i 1)
    (while (<= i n)
      (setq k (- i 1))
      (setq point (ssname cxj k))
      (setq point (entget point))
      (setq point (nth l point))
      (setq i1 (rtos i 2 0))
      (setq x1 (nth 1 point))
      (setq y1 (nth 2 point))
      (setq xa (+ x1 La))
      (setq ya (+ y1 Lb))
      (setq xb (- xa L1b))
      (setq yb (+ ya L1a))
      (setq xc (- xb L2a))
      (setq yc (- yb L2b))
      (setq xd (- x1 (- L2a La)))
      (setq yd (- y1 (- L2b Lb)))
      (setq p1 (list xa ya))
      (setq p2 (list xb yb))
      (setq p3 (list xc yc))
      (setq p4 (list xd yd))
      (setq p (list p1 p2 p3 p4))
      (setq jhj	(ssget "Wp"
		       p
		       (list (cons 8 "GCD") (cons 0 "TEXT"))
		) ;_ 结束ssget
      ) ;_ 结束setq
      (setq z (sslength jhj))
      (cond	((/= z 0)
	((setq point (ssname jhj 0))
	(setq point (entget point))
	(setq point (cdr (assoc 1 point)))
      ))
      (setq xb (+ xa L3b))
      (setq yb (- ya L3a))
      (setq xc (- xb L2a))
      (setq yc (- yb L2b))
      (setq p2 (list xb yb))
      (setq p3 (list xc yc))
      (setq p (list p1 p2 p3 p4))
      (setq jhj	(ssget "Wp"
		       P
		       (list (cons 8 "GCD") (cons 0 "TEXT"))
		) ;_ 结束ssget
      ) ;_ 结束setq
      (setq y (sslength jhj))
      (cond	((/= y 0)
	(setq point1 (ssname jhj 0))
	(setq point1 (entget point1))
	(setq point1 (cdr (assoc 1 point1)))
      )
      (if (or (= 0 z) (= 0 y))
	  (setq OK O)
	)
       
       (setq h (strcat point "." point1 "00"))
	       (setq h (distof h 2))
	       (setq h (+ hi h))
	       (setq h (rtos h 2 3))
	       (setq x1 (rtos x1))
	       (setq y1 (rtos y1))
	       (setq jhj (strcat i1 ",," x1 "," y1 "," h))
	       (write-line jhj fn)
	  )
	
	(setq i (+ i 1))
      )) ;_ 结束while
    )
    (close fn)
    (setq x1 nil
	  y1 nil
	  hi nil
	  h nil
	  cxj nil
	  jhj nil
	  i nil
	  k nil
	  fn nil
	  filename nil
	  l nil
    ) ;_ 结束setq
    (setq p1 nil
	  p2 nil
	  point	nil
	  point1 nil
	  D nil
	  JA nil
    ) ;_ 结束setq
    (cond ((= OK 1)
	   (prompt "\n数据转换成功!")
	  )
	  ((= OK 0)
	   (prompt "\n数据转换完毕，但存在错误转换不完全!")
	  )
    )
    (setq OK nil)
    (princ)
  ) ;_ 结束defun


					;*** 请不要在注释下添加文字! ***|;
)