dwg图型输出为lisp文件

(defun c:tt(/ basicpoint codeorder fileheadstring filename fileobject i k kdxf listnonstringcodes memberp nonstrl notneedcodes obdxf
             obename objections replacestring sdxf startEntity strdxfstringcodes strl vlaobjects)
  ;;;--------------------------------------------------------------------------------  
  (defun memberp ( Obj listObjects / i boolResult)
    (setq boolResult "NO" )
    (setq i 0)
    (while (and (= boolResult "NO") 
             (vla-object ename) lst))
    )
    lst
  )
 ;;; -------------------------------------------------------------------------
;;选择集生成无名组
(defun AddUnNameGroup (ss / actDwg objGroup ss2array)
(defun SS2Array (ss / c r en)
  (repeat (setq c (sslength ss))
    (setq en (ssname ss (setq c (1- c))))
    (if  (entget en)
      (setq r (cons en r))
    )
  )
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbObject
      (cons 0 (1- (length r)))
    )
    (mapcar 'vlax-ename->vla-object r)
  )
)  
   (setq actDwg (vla-get-activedocument  (vlax-get-acad-object)))
  (vla-AppendItems (setq objGroup (vla-add (vla-get-Groups actDwg) "*")) (SS2Array ss))
  objGroup
  )
 ;;; -------------------------------------------------------------------------
;;说明：把自指定对象开始生成的所有对象，加入到一个新的无名组
(defun AddToNewGroupFrom( addNewGroupBeginEntity / groupEntities )  
  (setq groupEntities (ssadd addNewGroupBeginEntity))
  (while (setq addNewGroupBeginEntity (entnext addNewGroupBeginEntity ))
    (setq groupEntities (ssadd addNewGroupBeginEntity groupEntities)) 
  )        
  (AddUnNameGroup groupEntities)
)
;;;-----------------------------------------------------------------
  (princ "\n选择需要的对象:")  
  (if (setq objections (ssget '((0 . "*line,*text,arc,circle,ellipse,hatch,dimension,ray"))))
    (progn
      (setq basicPoint (getpoint "需要复制的对象的插入基点："))
      (setq vlaObjects (SelectSet2VlaObjects objections ))
      (foreach obj vlaObjects
        (vla-move obj   (vlax-3d-point basicPoint)  (vlax-3d-point '(0  0 )) )
      )
      
      (setq fileName "d:/makeEntity.lsp")
      (setq FileObject (open fileName "w"))
      
      (setq NotNeedCodes (list -3 -1 2 5 102 330 340 )) ;所有不需要保留的组码的第一个元素
      
      (setq FileHeadString "(defun NewSignOrBlock (  / startEntity ) \n")
      (setq codeOrder (list "string"))
      ;;coder记录按顺序输出结果时，组码第二个元素是否是字符串，用于在生成结果文件时地确定是输出strDxfStringCodes还是listNonStringCodes中的元素
      
      (setq i -1)
      (while (setq obEname (ssname objections (setq i (1+ i))))
        (setq obDxf (entget obEname))
        (setq k -1)
        (setq strDxfStringCodes (list "(entmake '(") ) 
        (setq listNonStringCodes nil)
        ;;组码第二个元素是字符串的和不是字符串的分开保存，字符串需要程序在保存文件中添加分号，非字符的直接用princ函数输出即可
        
        ;;逐个处理选择对象，生成需要输入的结果表strDxfStringCodes、listNonStringCodes，及记录结果表中的各组码类型的codeOrder
        (while (setq kDxf (nth (setq k (1+ k)) obDxf))
          (if  (/=  (memberp (car kDxf ) NotNeedCodes ) "YES")  
            (progn                  
              (setq sdxf  (cdr kDxf ))     
              (if (or (numberp sdxf) 
                    (listp sdxf)               
                  )  
                (progn
                  (setq listNonStringCodes (append listNonStringCodes (list kDxf)))
                  (setq codeOrder (append codeOrder (list "NotString")))
                )
                
                (progn
                  (setq strDxfStringCodes (append strDxfStringCodes (list (strcat "(" (rtos (car kDxf)) " . "" (cdr kDxf) "")"))))
                  (setq codeOrder (append codeOrder (list "string")))
                )
              )      
            )
            
          )
        )
        
        ;;以下输出结果文件数据
        ;;生成文件部分不变内容
        (if ( = i 0)
          (princ FileHeadString FileObject)
        )
        
        ;;逐个生成选择对象组码数据
        (setq strL -1)
        (setq NonStrL -1)
        (foreach order codeOrder 
          (if (= order "string")
            (progn
              (setq strL (1+ strL))
              (if ( i 1)
        (princ "(AddToNewGroupFrom startEntity)\n(princ)\n)\n(NewSignOrBlock)\n" FileObject)  
        (princ "(princ)\n)\n(NewSignOrBlock)\n" FileObject)  
      )  
      (close FileObject)
      
      (replaceString)
    )
  )
  
  (foreach obj vlaObjects
    (vla-move obj    (vlax-3d-point '(0  0 ))  (vlax-3d-point basicPoint))
  )
  (princ)
)