[LISP程序]：我编写 的制作hatch的程序(c:mkpat)

ulganix

我自己写的制作hatch pattern的程序，要求横向和纵向偏移距离相等。
本人是学习alisp不久，希望多和大家交流。
;;;mkpat主函数
;;;
;;;
(defun c:mkpat( / fileFullName fileNameBase head ss po_d sn ent pt1 pt2 ang_deg fin)
   
;;;建立pat文件，写入文件头
   (setq fileFullName
       (getfiled "Create a new pat file" "c:\\pat\\" "pat" 1)
   );得到文件名和路径
   (setq fileNameBase (vl-filename-base fileFullName));得到文件名
  
   (setq head (strcat "*" fileNameBase ",lx's pattern"))
   (str->file fileFullName head "w")
;;;建立选择集。
   (setq ss (ssget))

;;;取得原点和偏移距离(po d)
   (setq po_d (mkpat:getUserInput))

;;;开始循环
   (setq sn 0)
   (repeat (sslength ss)
     
      (setq ent (ssname ss sn))  (setq sn (1+ sn))
      (setq pt1 (car (getLineData ent))
            pt2 (cadr (getLineData ent))
            ang_deg (rad->deg (caddr (getLineData ent)))
      );对其中的每根直线进行判断,取得pt1，pt2,ang_deg。
     ;(print pt1)
     ;(print pt2)
     ;(print ang_deg)
      (cond;进行判断
          ((< (abs (- 0 ang_deg)) 0.01) (mkpat:writeSpecialAng 0 pt1 pt2 po_d))
          ((< (abs (- 180 ang_deg)) 0.01) (mkpat:writeSpecialAng 180 pt1 pt2 po_d))
          ((< (abs (- 90 ang_deg)) 0.01)  (mkpat:writeSpecialAng 90 pt1 pt2 po_d))
          (T (mkpat:writeGeneralAng  pt1 pt2 po_d))
         
      );结束cond
  
   
      
   );结束repeat

;;;
  (setq fin (strcat "\n*****Pattern <" fileNameBase ">  has been created!"))
  (princ fin)
  (princ)
);结束c:mkpat

;;;取得用户输入。getpoint基点po,getdist测距点ptd1，ptd2,偏移距离d
(defun mkpat:getUserInput(/ po d)
        (setq po (getpoint "Base Point :\n"))
        (prompt "**Get Offset Distance** :\nFirst Point :\n")
        (setq d (getdist))
        (list po d)
        
)


;;;建立pat文件，写入文件头,清除原有内容
(defun str->file(fileFullName str  mod / f fileNameBase)
  
  (setq f (open fileFullName mod));打开文件写入
  
  
  
  (write-line str f);写文件
  
  (close f);关闭文件
  

)

;;;对0,90,180等特殊角度专门处理
(defun mkpat:writeSpecialAng(ang pt1 pt2 po_d / solid_dash void_dash x y dx dy)
  (setq solid_dash (distance pt1 pt2)
        void_dash  (- solid_dash (cadr po_d))
  )

  (setq x (- (car pt1) (car (car po_d)))
        y (- (cadr pt1) (cadr (car po_d)))
  )
  
  (setq dx 0
        dy (cadr po_d)
  )
  (str->file fileFullName (mkpat:makePatternData ang x y dx dy solid_dash void_dash) "a")
)
;;;对于其他角度的处理
(defun mkpat:writeGeneralAng(pt1 pt2 po_d / di tan @a m n d po width height period void_dash x y x_old dx dy y_old)
  (setq di (distance pt1 pt2)) ;距离

  (setq tan  (tg (angle pt1 pt2)))
  ;角度
  (setq @a (rad->deg (atan tan)))
  (if (< @a 0) (setq @a (+ 180 @a)))
  ;整数比
  (setq m (car (int_pro (abs tan)))
        n (cadr (int_pro (abs tan)))
  )
  (if (or (> m 40) (> n 40))
      (progn
          (alert "Please simply input data to interg point!")
          (quit)
      )
  );结束if
  (list @a m n)
  ;基本矩形数据
  (setq d (cadr po_d)) (setq po (car po_d))
  (setq width (* n d) height (* m d))
  (setq period (sqrt (+ (* width width) (* height height))))
  (setq void_dash (- di period))

  (setq x (- (car pt1) (car po))
        y (- (cadr pt1) (cadr po))
  )
  
  (setq dx (* width -1 (cos (atan tan)))
        dy (* width (sin (atan tan)))
  )
  ;写入文件
  (setq x_old x
        y_old y)
  (repeat  n
          (str->file fileFullName
                     (mkpat:makePatternData @a x y dx dy di void_dash)
                     "a"
          )
          (repeat (- m 1)
               (setq y (+ y d))
               (str->file fileFullName
                    (mkpat:makePatternData @a x y dx dy di void_dash)
                     "a"
               )
               
          )
          (setq x (+ x d))
  )
  

)

;;;生成填充纪录数据
(defun mkpat:makePatternData(ang_deg x y dx dy solid_dash void_dash)
  (strcat (rtos ang_deg) "," (rtos x) "," (rtos y) "," (rtos dx) ","
          (rtos dy) "," (rtos solid_dash) "," (rtos void_dash)
  )
)

userzhluserzhl

选择对象:  Base Point :
**Get Offset Distance** :
First Point :
指定第二点: ; 错误: no function definition: GETLINEDATA

yy99

好像运行不了阿？

ulganix

;;;取得直线基本数据
(defun getLineData(ent / entdata pt1 pt2 pt ang_rad)
  
  (setq entdata (entget ent))
  (setq pt1 (cdr (assoc 10 entdata)));得到pt1
  (setq pt2 (cdr (assoc 11 entdata)));得到pt2
  (if  (>= (cadr pt1) (cadr pt2)) ;使得pt2在pt1上方
      (progn
           (setq pt pt1)
           (setq pt1 pt2)
           (setq pt2 pt)
      )
  );结束if
  
  (list pt1  pt2 (angle pt1 pt2));返回pt1,pt2,角度
  
  
)

userzhluserzhl

我想请问一下，楼主有没有调试过？
命令: mkpat
选择对象: 指定对角点: 找到 4 个

选择对象:  Base Point :
>>Base Point :
**Get Offset Distance** :
First Point :
指定第二点: ; 错误: no function definition: RAD->DEG

lewyee

能够填充的LISP全世界就两三家！一家个人，一家公司。都是要钱的，楼猪走好

shq197528

都有这样的外挂软件了!不用编写了吧!

winabcd

楼主：你能不能说说你的编程思路，这样大家可以更好的理解你的程序。

sgtsj

错误: no function definition: RAD->DEG
楼主可以再看看吗？