Tools/代码/LSP/GB512/lisptool/2002.LSP

;;;;;;;;;;;;;;;;;;;;;;;;获得线的节点表;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;{get-line-list 实体名(Type:"LWPOLYLINE" OR "POLYLINE")};
;;返回3D   line-list ,line-elev ,ames-plnclose=1 close
(defun get-line-list (line-en-name / line-name-list line-type)
  (setq ames-plnclose 0)
  (setq line-name-list (entget line-en-name))
  (setq line-type (cdr (assoc 0 line-name-list)))
  (cond
    ((= line-type "LWPOLYLINE") (get-lwpl-List line-en-name)) 
    ((= line-type "POLYLINE")   (get-pl-List line-en-name))   
    (T (prompt "\n此实体不是多义线!") (setq line-list nil) (setq line-elev nil) (EXIT)) 
  );endcond
);end get-line-list

;获得LWPOLYLINE线节点表
(defun get-lwpl-List(line-en-name / line-name-list list-length
                      pt1  p10  ptx  pty pt   I  m kk D70 ) 
  (setq line-name-list (entget line-en-name))
  (setq list-length (length line-name-list))
  (setq line-list nil)
  (setq line-elev (cdr (assoc 38 line-name-list)))
    (setq d70 (cdr (assoc 70 line-name-list)))
  (setq I 0	m 0)
(while (< m 20)
        (progn
      (setq kk (car (nth m line-name-list)))
  (if (= kk 10)
      (progn
   (setq i m)
   (setq m 21)
  ))
     (setq m (+ 1 m))
))
(while (< i list-length)
	(progn
	(setq pt1  (nth i line-name-list))
	(setq p10 (nth 0 pt1))
      (if (= p10 10)
	(progn
	(setq ptx (nth 1 pt1))
	(setq pty (nth 2 pt1))
	(setq pt (list ptx pty line-elev))
	(setq line-list (cons pt line-list))
       ))
	(setq i (+ 4 i))
))
(IF (OR (= D70 1) (= D70 9) (= D70 129))
(PROGN
   (SETQ line-list (CONS (LAST line-list) line-list))
   (setq ames-plnclose 1)
))
(setq line-list (reverse line-list))
);end get-lwpl-List
;获得POLYLINE线节点表
(defun get-pl-List (line-en-name / line-name-list list-length  vertex-name vertex-prop 
	                           vertex-list ptx  pty  ptz pt  D70  ) 
  (setq line-list nil)
  (setq vertex-list (entget line-en-name))
  (setq d70 (cdr (assoc 70 vertex-list)))
  (setq vertex-name (entnext line-en-name))
  (setq vertex-list (entget vertex-name))
  (setq line-elev (nth 3 (assoc 10 vertex-list)))
  (setq vertex-prop (cdr (assoc 0 vertex-list)))
  (while (/= vertex-prop "SEQEND")
    (setq pt (cdr (assoc 10 vertex-list)))
    (if (/= pt nil)
      (progn
        (setq ptx (nth 0 pt))
        (setq pty (nth 1 pt))
	(setq ptz (nth 2 pt))
        (setq pt (list ptx pty ptz))
        (setq line-list (cons pt line-list))
       );endprogn
     );endif
    (setq vertex-name (entnext vertex-name))
    (setq vertex-list (entget vertex-name))
    (setq vertex-prop (cdr (assoc 0 vertex-list)))
   );endwhile
(IF (OR (= D70 1) (= D70 9) (= D70 129))
(PROGN
   (SETQ line-list (CONS (LAST line-list) line-list))
   (setq ames-plnclose 1)
))
  (setq line-list (reverse line-list))
  
);end get-pl-List
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:gw()
(command "layer" "make" "gw" "" "")
(setq dxy 100)
(setq minx 999999999 miny 999999999 maxx -999999999 maxy -999999999)
(setq zjtk (entsel " 输入图框："))
(if (/= zjtk nil)
(progn
(setq zjtked (car zjtk))
(setq lt (get-line-list zjtked))
(setq Lit (length lt))
(setq n 0)
;;;;;;;GET TKFW
(while (< n lit)
(setq xy (nth n lt))
(setq x (nth 0 xy))
(setq y (nth 1 xy))
(setq minx (min minx x))
(setq miny (min miny y))
(setq maxx (max maxx x))
(setq maxy (max maxy y))
(setq n (+ 1 n))
)
;;;;;;;;;;;GET TKFW
(setq x (- maxx minx))
(setq y (- maxy miny))
(setq xL (fix (/ x dxy)))
(setq yL (fix (/ y dxy)))
(setq i 1)
(while (< i xL)
(setq j 1)
(while (< j yL)
(setq x (+ minx (* i dxy)))
(setq y (+ miny (* j dxy)))
(setq pt1 (list minx y))
(setq pt2 (list maxx y))
(command "pline" pt1 pt2 "")
(setq pt1 (list x miny))
(setq pt2 (list x maxy))
(command "pline" pt1 pt2 "")
;(command "text" pt1 5 0 "0") 
(setq j (+ j 1))
)
(setq i (+ i 1))
)

))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq mypi  3.1415926)
(defun dtor(d)
(setq r_d (* (/ d 180) mypi))
)
(defun rtod(r)
(setq d_d (* (/ r mypi) 180))
)
;;;;;;;;;;;;;;;
;;;;;;;;在表 lt 中与点 pt 最进的点ptm
(defun p-lt-min(pt lt / i pti mins n dis)
 (setq mins 9999.0)
 (if (and (/= lt nil) (/= pt nil))
 (progn
 (setq n (length lt))
 (setq i 0)
 (repeat n
 (setq pti (nth i lt))
 (if (/= pti nil)
 (progn
 (setq dis (distance pt pti))
 (if (< dis mins)
  (progn
 (setq mins dis)
 (setq ptm pti)
 ))
 ));if pti
 (setq i (+ 1 i))
  );repeat
 ));if and
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:zj()
   (setvar "aunits" 0)
   (setvar "luprec" 0)
   ;(SETQ sty nil)
   (while (= sty nil)
          (command "style" "standard" "rs,hztxt" "0" "0.75" "0" "n" "n" "n""")
          (setq sty 12345678)
   )
   (command "layer" "m" "8121" "c" "32""""")
   ;(SETQ BILI nil)
   (while (= BILI nil)
          (setq BILI (getint "Input scale parameter:"))
   )
   (setq e (entsel "选择曲线:"))
   (setq en (car e))
   (setq lt (get-line-list en))
   (setq ed (entget en))
   (setq pt (nth 0 lt))
   (setq qxz (caddr pt))
   (setq qxz (rtos qxz))
  
   (setq pkpt (cadr e))
   (p-lt-min pkpt lt)
   (setq pkpt ptm)

   (setq ang (getangle pkpt "\n给定注记方向  :"))
   (if (/= ang nil)
    (progn
	    (setq ang (- (/ (* ang 180) 3.1415926) 90))
	    (command "text" "j" "mc" pkpt (* 0.002 bili) ang qxz)
;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;
	    )

    )
	(setvar "luprec" 6)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(PRINC  "\nLoaded!")
(PRINC  "\n <command: zj>")