[编程交流] 调用另一个LISP失败

 
;* DATE 05/20/93 
;*REVISED 08/08/00
(setvar "REGENMODE" 1) 
;***********************************************************************
;* Function: DXF (Generic)
;* Created by: Rocky W. (3/10/94)
;* Parameters in:
;* Returns:
;* Comments: takes an integer DXF code and an entity list, and
;*    returns the data element of the associated pair.
(defun err (s)
  (if (not (MEMBER s '("console break " "Function cancelled")))
     (princ (strcat "\nERROR: " s))
  )
  (progn
     ;(command "_.U")
     ;(COMMAND "_.redraw")
  )
  (setq *error* olderr)
  (princ)
)
(defun DXF (code elist)
  (cdr (assoc code elist))
)
;***********************************************************************
;* Function:C:Hotspot
;* Used by:DSD group
;* Parameters in:
;* Returns:
;* Comments:Used to semi automate the process of assigning attributes to 
;*          blocks and regions in a drawing.
;*          region is update by autobox for exiting region with new cords.
(defun C:AUTOROCK(/ olderr)
(c:BOXQA) ; outlines existing attributed regions (helps track progress across the drawing)
  (command "ucs" "w");this sets the UCS back to World
  (if (tblsearch "LAYER" "NOPLOT")
     (command "_.Layer" "_S" "NOPLOT" "U" "NOPLOT" "")
     (Progn
        (command "_.Layer" "_M" "NOPLOT" "_C" "MAGENTA" "NOPLOT" "_LT" "CONTINUOUS" "NOPLOT" "U" "NOPLOT" "")
     )
  )       
  (setq rin nil
     mrin ""
     ulsize nil
     lrsize nil
     textdatin ""
     textdatout ""
     var (getvar "CMDECHO")
     atvar (getvar "AFLAGS")
     a2 nil
     atblk 1
     dname (getvar "dwgname")
     strleg (strlen dname)
     strleg1(- strleg 4)
     dpre  (getvar "dwgprefix")
  drawname (substr dname 1 strleg1))
  (setq olderr *error* *error* err)
  (setq cmdech var)
  (setvar "AFLAGS" 1)
  (autobox2)       ;* call function
  ; draw box from selection
  (setq p2 (list (car ul) (cadr lr) )) ;lr corner
  (setq p4 (list (car lr) (cadr ul) )) ;lr corner
  ;function to draw colored vectored region
  (grdraw ul p2 7 1)
  (grdraw p2 lr 7 1)
  (grdraw ul p4 7 1)
  (grdraw p4 lr 7 1)
  (prompt "\nPick all items that make up unit...")
  (setq ss2 (ssget))
  (setq a (dxf 2 (entget (ssname ss2 0))))
  (if (/= a nil)
     (setq a2 (tblsearch "BLOCK" a))     ;* true if a is a block
     (progn                               ;* false
        (setq xxx  (sslength ss2))   ;loop counter
        (setq cxxx 1)
        (setq textdat "")
        (while (<= cxxx xxx)
           (setq dat1 (entget (ssname ss2 (- cxxx 1))))
           (setq txttype (cdr (assoc 0 dat1)))
           (if (= txttype "TEXT")
              (progn                    ;* progn start
                 (setq txt1 (dxf 1 dat1))  ;if false
                 (setq textdat (strcat textdat txt1 " "))
                 (setq cxxx (+ 1 cxxx))
              )                         ;*progn end
           ) ;* endif
        ) ;while end
     ) ;*progn end 
  ) ;*endif block check
  (if rin ()(setq rin ""))
  (setq dscord (dxf 10 (entget (ssname ss2 0))))     ;* get insert point
  (setq dscord (list (- (car dscord) 0.05) (-(cadr dscord) 0.05)))
  (setq bname (ssname ss2 0))
  (if (and (/= a nil)(= (sslength ss2) 1)(/= a2 nil))
     (progn
        (setq en bname)
        (setq ed (entget en))
        (while (/= "SEQEND" (dxf 0 ed))                     ;*** while 2
           (setq en (entnext en))
           (setq ed (entget en))
           (setq tag (dxf 2 ed))
           (setq val (dxf 1 ed))
           (if (/= "SEQEND" (dxf 0 ed))                       ;*** if 2
              (progn                                            ;*** progn 2
                 (if (= "BOXSIZE" TAG)                                ;*** if 3
                    (progn                                          ;*** progn 3
                       (setq  ttval (read val))
                       ;*      (strcase ttval)
                       (if (/= ttval BSIZE)
                          (progn         
                             (setq ed (subst (cons 1 BSIZE)(assoc 1 ed) ed ))
                             (entmod ed)
                             (entupd en)
                             (PRINC (STRCAT "BOXSIZE CHANGED  " BSIZE " " VAL "   "))
                          )
                       )
                    )                                                ;*** progn 3
                 )                                                 ;*** endif 3
              )                                                  ;*** progn 2
           )                                                   ;*** endif 2 
        )                                                    ;*** while 2
[color=red];;;[/color]
[color=red];;;   [b]In place of this line, I would like to call CAB's routine MyAttEdit[/b][/color]
[color=red]  (command "DDATTE" bname)[/color]
[color=red];;;   [/color]
[color=red];;;   [/color]
  )
     (progn
        (command "attdef" "" "NAME" "Enter NAME." textdat dscord "")
        (setq nameattr1 (entlast))
        (command "attdef" "" "RIN" "Enter RIN." RIN dscord "")
        (setq nameattr2 (entlast))                                    
        (command "attdef" "" "BOXSIZE"  "Enter boxsize.     " bsize dscord "")
        (setq nameattr3 (entlast))
        (command "attdef" "" "MRIN"  "Enter SCLSIS Rin." mrin dscord "")
        (setq nameattr4 (entlast))
        (setq CurLayer( getvar "clayer"))
        (command "attdef" "" "CURRENTLAYER" "Enter Current Layer." "NOPLOT" dscord "")
        (setq nameattr5 (entlast))
        (command "attdef" "" "SHAPE" "Enter Object Shape Type." "R" dscord "")
        (setq nameattr6 (entlast))
        (command "attdef" "" "OBJTYPE" "Enter Object Type." "EQ" dscord "");MOD BY JDR 8/8/00
        (setq nameattr7 (entlast))
        (setq bname   (itoa atblk))
        (while (tblsearch "BLOCK"   (strcat drawname "$ECC$" bname))
           (progn                                       
              (setq atblk (+ atblk 1)                    
                 bname  (itoa atblk))
           )
        )
       (setq bname (strcat drawname "$ECC$" bname))
   (progn
         (command "block" bname dscord  nameattr1 nameattr2 nameattr3 nameattr4 nameattr5 nameattr6 nameattr7 )  
         (setq count 0
           emax (sslength ss2)
         )
         (while (< count emax)
           (command (ssname ss2 count))
           (setq count (1+ count))
         )
         (setvar "ATTREQ" 1)
         (setvar "ATTDIA" 1)
         (command "" "insert" bname dscord "1" "1" "0" )
   )
     )
  )
 (command "redraw") ;clears existing region outlines so NOID regions will display
(NOID) ;* call function to display "neglect" regions
)
(princ)
(defun AUTOBOX2()
  (setq bsize nil)
  (setq ul (getpoint "Pick UL corner: ")
  lr (getcorner ul "Pick LR corner: "))
  (setq bsize (strcat "("(rtos (car ul) 2 6) " " (rtos (cadr ul) 2 6) " " (rtos (car lr) 2 6) " " (rtos (cadr lr) 2 6)")" ))
);AUTOBOX2
;;This part written by LeeMac (cadtutor.net) 14 May 2009. Thanks, Lee.
(defun NOID (/ ss attLst Box ul lr); To outline regions with no ID
(vl-load-com)
(if (setq ss (ssget "_X" '((0 . "INSERT") (66 . 1))))
   (progn
     (foreach Obj (mapcar 'vlax-ename->vla-object
                    (mapcar 'cadr (ssnamex ss)))
       (setq attLst nil)
       (foreach att (vlax-safearray->list
                      (vlax-variant-value
                        (vla-getAttributes Obj)))
         (setq attLst (cons (cons (vla-get-TagString att)
                                  (vla-get-TextString att)) attLst)))
       (if (and (assoc "RIN" attLst)
                (eq "" (cdr (assoc "RIN" attLst)))
                (setq Box (assoc "BOXSIZE" attLst)
                      Box (read (cdr Box))))
         (progn
           (setq ul (list (car Box) (cadr Box))
                 lr (list (caddr Box) (cadddr Box)))
           (grvecs (list 1 lr (list (car lr) (cadr ul))
                         1 ul (list (car lr) (cadr ul))
                         1 lr (list (car ul) (cadr lr))
                         1 ul (list (car ul) (cadr lr)))))))))
 (princ)
)

(sssetfirst nil bname)
(C:MyAttEdit)

(myattedit bname nil nil)