[编程交流] 坐标系

(defun c:COOR ( / i l s x )
    ;; Define function, declare local variable symbols.
    ;; To understand why variable declaration is important, see http://bit.ly/15Qw104
 
(setq PNT1 (getpoint
"\nPick coordinate point: "))
(setq P1X (car pnt1)) ;x coord
(setq P1Y (cadr pnt1)) ;y coord
(setq STDX (rtos P1X 2 2))
(setq STDY (rtos P1Y 2 2))
(setq COORDN (strcat "Y " STDY ))
(setq COORDE (strcat "X " STDX ))
    (if ;; If we can retrieve a set of attributed blocks
        (setq s ;; Assign the selection set pointer to variable 's'
            (ssget "_X" ;; Search entire database (see http://bit.ly/137NmOJ for more info)
               '(
                    (0 . "INSERT") ;; Block References
                    (66 . 1) ;; Attributed
                    (2 . "coordinate") ;; with name coordinate (this assumes block is non-dynamic)
                )
            ) ;; end SSGET
        ) ;; end SETQ
        (progn
            ;; Evaluate the following expressions and return the result
            ;; of the last expression evaluated. PROGN is used as a
            ;; wrapper function so that we can pass multiple expressions
            ;; to the IF function as a single argument constituting the
            ;; 'then' parameter.
            (initget 6) ;; (+ 2 4): 2=prevent zero, 4=prevent negative
            (if (setq x (getreal "\nEnter first SEQUENCE number: ")) ;; Prompt user for rung number > 0
                (progn
                    ;; See above explanation for PROGN
                    ;; Construct an association list of attribute tags & values
                    ;; to pass to the LM:setattributevalues function
                    (setq l
                        (cons
                            (cons "SEQUENCE" (itoa (fix x))) ;; => e.g. ("SEQUENCE" . "2")
                            ;; Use a quoted literal list for the remaining tags/values
                            ;; as there are no expressions to be evaluated.
                            ;; For an explanation of the apostrophe, see http://bit.ly/1bW3rQK
                           '(
                                ("X"  . "20")
                                ("Y" .  "1")
                            )
                        ) ;; end CONS
                    ) ;; end SETQ
                    
                    ;; The resulting list might look like this:
                    ;; l = (("SEQUENCE" . "2") ("X"  . "20") ("Y" .  "1"))
                
                    ;; Repeat the following expressions a number of times
                    ;; equal to the number of items in the selection set.
                    ;; Note that the numerical argument for the repeat function
                    ;; is only evaluated once and hence the integer index variable 'i'
                    ;; will only be assigned a value once.
                    (repeat (setq i (sslength s))
                        ;; Call the LM:setattributevalues function with the block entity name
                        ;; and association list of attribute tags/values to be set.
                        (LM:SetAttributeValues (ssname s (setq i (1- i))) l)
                    ) ;; end REPEAT
                ) ;; end PROGN
            ) ;; end IF
        ) ;; end PROGN
        ;; Else no blocks were found...
        (princ "\nNo "COORDINATE" blocks were found.")
    ) ;; end IF
    
    (princ) ;; Supress the return of the last evaluated expression
) ;; end DEFUN
;; Set Attribute Values  -  Lee Mac
;; Sets the block attributes whose tags are found in the supplied
;; assocation list to their associated values.
;; Arguments:
;; blk - [ent] Block (Insert) Entity Name
;; lst - [lst] Association list of ((<TAG> . <Value>) ... )
;; Returns: nil
(defun LM:SetAttributeValues ( blk lst / enx itm )
    (if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
        (if (setq itm (assoc (strcase (cdr (assoc 2 enx))) lst))
            (progn
                (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
                    (entupd blk)
                )
                (LM:SetAttributeValues blk lst)
            )
            (LM:SetAttributeValues blk lst)
        )
    )
)
(princ) ;; Suppress the return of any loading expressions

(setq inc_no 1)
...
...
(while (setq PNT1 (getpoint "\nPick coordinate point: "))
  ....
  ....
  (setq inc_str (itoa inc_no))
  (command "mleader" pnt1 ptxt inc_str coordn coorde)
  (setq inc_no (1+ inc_no))
);end_while

6

7