- 第2节 acad.lsp
-
;;; ***** ACAD.LSP *****
;;; My personalized customization;;; ----- COMMAND-------
(DEFUN C:ZA () (COMMAND "ZOOM" "A") (PRINC))
;;;=====================================================(DEFUN C:AA()
(SETQ P (SSGET "X" (LIST (CONS 0 "INSERT") (CONS 2 "DWGNAME"))))
(SETQ L (SSLENGTH P))
(IF (NULL P)
(ALERT "BLOCK "DWGNAME" NOT FOUND.NPLEASE INSERT IT INTO DRAWING.")
(PROGN
(SETQ FN1 (GETVAR "DWGPREFIX"))
(SETQ FN2 (GETVAR "DWGNAME"))
(SETQ SFN1 (SUBSTR FN1 1 3))
(SETQ SFN2 (SUBSTR FN2 1 3))
(IF (/= SFN1 SFN2) (SETQ FN2 (STRCAT FN1 FN2)))
(SETQ FN2 (STRCAT FN2 ""))
(SETQ COUNT 0)
(WHILE (< COUNT L)
(SETQ E (ENTGET (SETQ S (SSNAME P COUNT))))
(SETQ E1 (ENTGET (SETQ S1 (ENTNEXT S))))
(SETQ AS (ASSOC 1 E1))
(SETQ E1 (SUBST (CONS 1 FN2) AS E1))
(ENTMOD E1)
(ENTMOD E)
(SETQ COUNT (1+ COUNT))
)
(PRINC "N")
(PRINC FN2)
(PRINC)
)
)
(SETQ P (SSGET "X" (LIST (CONS 0 "INSERT") (CONS 2 "LAY_LIST"))))
(SETVAR "ATTDIA" 0)
(IF (NULL P)
(ALERT "BLOCK "LAY_LIST" NOT FOUND.NPLEASE INSERT IT INTO DRAWING.")
(PROGN
(SETQ P (SSGET "X" (LIST (CONS 0 "INSERT") (CONS 2 "LAY_LIST"))))
(SETQ B1 (TBLNEXT "LAYER" 0))
(SETQ T1 "")
(SETQ E (ENTGET (SETQ S (SSNAME P 0))))
(SETQ COUNT 0)
(WHILE (NOT (NULL B1))
(SETQ V1 (CDR (ASSOC 70 B1)))
(SETQ COUNT (1+ COUNT))
(IF (<= COUNT 70)
(PROGN
(SETQ T2 (CDR (ASSOC 2 B1)))
(IF (NOT (OR (= T2 "0") (= T2 "DEFPOINTS")))
(PROGN
(SETQ E1 (ENTGET (SETQ S1 (ENTNEXT S))))
(IF (= (CDR (ASSOC 0 E1)) "ATTRIB")
(PROGN
(SETQ AS (ASSOC 1 E1))
(SETQ E1 (SUBST (CONS 1 T2) AS E1))
(ENTMOD E1)
)
)
(SETQ S S1)
)
)
)
)
(SETQ B1 (TBLNEXT "LAYER"))
)
(SETQ COUNT (1+ COUNT))
(WHILE (<= COUNT 70)
(SETQ E1 (ENTGET (SETQ S1 (ENTNEXT S))))
(IF (= (CDR (ASSOC 0 E1)) "ATTRIB")
(PROGN
(SETQ AS (ASSOC 1 E1))
(SETQ E1 (SUBST (CONS 1 "") AS E1))
(ENTMOD E1)
)
)
(SETQ S S1)
(SETQ COUNT (1+ COUNT))
)
)
)
(ENTMOD E)
(PRINC)
)
;;; --------------------------------------------------------------------------
;;; ------------------ LAYER SETTING & CHANGE --------------------------------
;;; --------------------------------------------------------------------------
(DEFUN C:CV( / E N)
(SETQ E (CAR (ENTSEL "PICK AN OBJ.ON THE LAYER YOU WISHED:")))
(IF E (PROGN
(SETQ E (ENTGET E))
(SETQ N (CDR (ASSOC 8 E)))
(COMMAND"LAYER" "SET" N "")))
)
(DEFUN C:CX()
(PRINC "SELECT OBJ.TO MAKE IT IN CURRENT LAYERN")
(SETQ SS (SSGET))
(IF (AND SS (> (SSLENGTH SS) 0))
(PROGN
(SETQ ENT (ENTSEL "NSELECT OBJECT TO CHANGE TO OR <ENTER> FOR CURRENT:"))
(IF ENT (SETQ LA (CDR(ASSOC 8 (ENTGET (CAR ENT)))))
(SETQ LA (GETVAR "CLAYER")))
(COMMAND ".CHPROP" SS "" "LAYER" LA "")))
(PRINC)
)
;;; --------------------------------------------------------------------------
(DEFUN C:FV (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS ISOLATED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "OFF" "*" "Y" "ON" (EVAL FL) "")
(PRINC))
(DEFUN C:FG ()
(SETVAR "CMDECHO" 0)
(PROMPT"NSELECT ENTITIES TO TURN OFF:")
(SETQ SS (SSGET))
(IF (AND SS (SSLENGTH SS) 0)
(PROGN
(SETQ CT 0 LEN (SSLENGTH SS) CL (GETVAR "CLAYER"))
(COMMAND ".LAYER")
(WHILE (< CT LEN)
(SETQ LA (CDR (ASSOC 8 (ENTGET (SSNAME SS CT)))))
(IF (/= CL LA)(COMMAND "OFF" LA)
(PROGN (PROMPT "NTHE LAYER")
(PROMPT LA)
(PROMPT "IS CURRENT!")
) ;END OF PROGN
) ;END OF IF
(IF (= OLD NIL)(SETQ OLD LA)(SETQ OLD (STRCAT OLD "," LA)))
(SETQ CT (1+ CT))
) ;END OF WHILE
(COMMAND"")
) ;END OF PROGN
) ;END OF IF
(PRINC)
(SETVAR "CMDECHO" 0) (PRIN1)
)
(DEFUN C:VX (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS FREEZED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "F" (EVAL FL) "")
(PRINC))
(DEFUN C:VT (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS LOCKED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "LO" (EVAL FL) "")
(PRINC))
(DEFUN C:VU (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS UNLOCKED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "U" (EVAL FL) "")
(PRINC))
;;;--------------------------------------------------------------------------
;;; ------------------ LAYER SETTING & CHANGE 2 -----------------------------
;;; -------------------------------------------------------------------------
(DEFUN C:LLI (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS ISOLATED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "OFF" "*" "Y" "ON" (EVAL FL) "")
(PRINC))
(DEFUN C:LLO ()
(SETVAR "CMDECHO" 0)
(PROMPT"NSELECT ENTITIES TO TURN OFF:")
(SETQ SS (SSGET))
(IF (AND SS (SSLENGTH SS) 0)
(PROGN
(SETQ CT 0 LEN (SSLENGTH SS) CL (GETVAR "CLAYER"))
(COMMAND ".LAYER")
(WHILE (< CT LEN)
(SETQ LA (CDR (ASSOC 8 (ENTGET (SSNAME SS CT)))))
(IF (/= CL LA)(COMMAND "OFF" LA)
(PROGN (PROMPT "NTHE LAYER")
(PROMPT LA)
(PROMPT "IS CURRENT!")
) ;END OF PROGN
) ;END OF IF
(IF (= OLD NIL)(SETQ OLD LA)(SETQ OLD (STRCAT OLD "," LA)))
(SETQ CT (1+ CT))
) ;END OF WHILE
(COMMAND"")
) ;END OF PROGN
) ;END OF IF
(PRINC)
(SETVAR "CMDECHO" 0) (PRIN1)
)
(DEFUN C:LLF (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS FREEZED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "F" (EVAL FL) "")
(PRINC))
(DEFUN C:LLK (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS LOCKED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "LO" (EVAL FL) "")
(PRINC))
(DEFUN C:LLU (/ ES EN EL A)
(PRINC "SELECTED ENTITY(S) LAYERS UNLOCKED.")
(SETQ ES (SSGET) A 0 EN "" EL NIL FL NIL)
(WHILE (/= EN NIL)
(SETQ EN (SSNAME ES A) EL (CONS EN EL) A (1+ A)))
(SETQ EL (CDR EL) FL (CDR (ASSOC ' 8 (ENTGET (CAR EL)))) EL (CDR EL))
(REPEAT (- A 2)
(SETQ EN (CDR (ASSOC ' 8 (ENTGET (CAR EL))))
FL (STRCAT EN "," FL) EL (CDR EL)) )
(COMMAND "LAYER" "U" (EVAL FL) "") (PRINC))
(DEFUN C:FA () (COMMAND "LAYER" "ON" "*" "") (PRINC))
(DEFUN C:VA () (COMMAND "LAYER" "ON" "*" "") (PRINC))
(DEFUN C:TA () (COMMAND "LAYER" "THAW" "*" "") (PRINC))
;;; --------------------------------------------------------------------------
(DEFUN C:1 () (COMMAND "ZOOM" "0.75X") (PRINC))
(DEFUN C:2 () (COMMAND "ZOOM" "0.50X") (PRINC))
(DEFUN C:3 () (COMMAND "ZOOM" "1.5X") (PRINC))
(DEFUN C:ACAD () (COMMAND "MENU" "ACAD") (PRINC))
(DEFUN C:BB () (COMMAND "BREAK" PAUSE "F" PAUSE "@0,0") (PRINC))
(DEFUN C:CAD () (COMMAND "MENU" "CAD") (PRINC))
(DEFUN C:CC () (COMMAND "COPY" "P""M") (PRINC))
(DEFUN C:CCE () (COMMAND "UCS" "E"))
(DEFUN C:CCW () (COMMAND "UCS" "W"))
(DEFUN C:CZ () (COMMAND "LAYER" "SET" "0" ""))
(DEFUN C:EE ()(COMMAND "ERASE" "P" "") (PRINC))
(DEFUN C:L0 () (COMMAND "LAYER" "SET" "0" ""))
(DEFUN C:LD () (COMMAND "LENGTHEN" "DY") (PRINC))
(DEFUN C:R1 () (COMMAND "REGENMODE" "1") (PRINC))
(DEFUN C:T1 () (COMMAND "TILEMODE" "1"))
(DEFUN C:T0 () (COMMAND "TILEMODE" "0"))
(DEFUN C:T2 () (COMMAND "TILEMODE" "0"))
(DEFUN C:VD () (COMMAND "LENGTHEN" "DY") (PRINC))
(DEFUN C:WW () (COMMAND "MOVE" "P") (PRINC))
(DEFUN C:ZD () (COMMAND "ZOOM" "D") (PRINC))
(DEFUN C:ZE () (COMMAND "ZOOM" "E") (PRINC))
(DEFUN C:ZZ () (COMMAND "ZOOM" "P") (PRINC))
(SETVAR "CMDECHO" 0)
(DEFUN DTR (A) (* PI (/ A 180.0)))
(DEFUN RTD (A) (* (/ A PI) 180.0))
(DEFUN C:CLEAR ()
(SETQ ATOMLIST (MEMBER 'C:CLEAR ATOMLIST))
)
(DEFUN C:AV ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJECT...N")
(SETQ SS(SSGET))
(SETQ NN(GETINT "NINPUT THE NUMBER OF ROWS:"))
(SETQ S1(GETINT "NINPUT HORIZONTAL DISTANCE:"))
(COMMAND "ARRAY" SS "" "R" NN "" S1) (SETVAR "CMDECHO" 1) (PRINC)
)
(DEFUN C:AH ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJECT...N")
(SETQ SS(SSGET))
(SETQ NM(GETINT "NINPUT THE NUMBER OF COLUMNS:"))
(SETQ S1(GETINT "NINPUT VERTICAL DISTANCE:"))
(COMMAND "ARRAY" SS "" "R" "" NM S1) (SETVAR "CMDECHO" 1) (PRINC)
)
(DEFUN C:C (/ SS FL)
(PRINC "NSELECT OBJECTS: ")
(SETQ SS (SSGET))
(SETQ N (SSLENGTH SS))
(COMMAND "COPY" SS "" "M" "") (REPEAT N (COMMAND "" COPY "" ""))
)
(DEFUN C:CS ()
(SETQ S1 (SSGET))
(SETQ STYLE (GETSTRING "NEW STYLE: " ))
(SETQ N (SSLENGTH S1))
(COMMAND "CHANGE" S1 "" "") (REPEAT N (COMMAND "" STYLE "" ""))
)
(DEFUN C:DRF ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "DRAWORDER" SS "" "FRONT") (PRINC))
(DEFUN C:DRB ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "DRAWORDER" SS "" "B") (PRINC))
(DEFUN C:VW ()
(SETQ MAXTEST (GETVAR "LIMMAX"))
(SETQ MAXSET (GETVAR "EXTMAX"))
(SETQ MINSET (GETVAR "EXTMIN"))
(SETVAR "LIMMAX" (LIST (+ (CAR MAXSET) 0.01)
(+ (CADR MAXSET) 0.01)))
(SETQ SETMIN (LIST (+ (CAR MINSET) -0.01)
(+ (CADR MINSET) -0.01)))
(SETVAR "LIMMIN" SETMIN)
(IF ( /= MAXTEST (GETVAR "LIMMAX"))
(COMMAND "ZOOM" "A"))
)
;;; --------------------------------------------------------------------------
;;; ---------------------------- DIMENSIONS ----------------------------------
;;; --------------------------------------------------------------------------
(DEFUN C:DA () (COMMAND "DIM" "AL") (PRINC))
(DEFUN C:DB () (COMMAND "DIM" "BASELINE") (PRINC))
(DEFUN C:DC () (COMMAND "DIM" "CONTINUE") (PRINC))
(DEFUN C:DDA () (COMMAND "DIM" "DIAMETER") (PRINC))
(DEFUN C:DFA () (COMMAND "DIM" "DIMLFAC") (PRINC))
(DEFUN C:DG () (COMMAND "DIM" "ANGULAR") (PRINC))
(DEFUN C:DH () (COMMAND "DIM" "HOR") (PRINC))
;;(DEFUN C:DHM () (COMMAND "DIM" "HOM") (PRINC))
(DEFUN C:DHM ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "DIM" "HOM" SS "" "E") (PRINC))
(DEFUN C:DE () (COMMAND "DIM" "LEADER") (PRINC))
(DEFUN C:DN () (COMMAND "DIM" "NEW") (PRINC))
(DEFUN C:DRA () (COMMAND "DIM" "RADIUS") (PRINC))
(DEFUN C:DRT () (COMMAND "DIM" "ROTATED") (PRINC))
(DEFUN C:DST () (COMMAND "DIM" "STYLE") (PRINC))
;;(DEFUN C:DU () (COMMAND "DIM" "UP") (PRINC))
(DEFUN C:DU ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "DIM" "UP" SS "" "E") (PRINC))
(DEFUN C:DV () (COMMAND "DIM" "VER") (PRINC))
;;; --------------------------------------------------------------------------
;;; ------------------ COLOR SETTING & CHANGE --------------------------------
;;; --------------------------------------------------------------------------
(DEFUN C:C0 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 0#: ")
(SETQ SS(SSGET))
(COMMAND "CHANGE" SS "" "PROPERTIES" "C" "0" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C1 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 1#: ")
(SETQ SS(SSGET))
(COMMAND "CHANGE" SS "" "PROPERTIES" "C" "1" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 2#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C3 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 3#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "3" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C4 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 4#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "4" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C5 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 5#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "5" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C6 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 6#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "6" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C7 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 7#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "7" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C8 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 8#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "8" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:C9 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BE 9#: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "9" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CB ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. COLOR BYLAYER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "C" "BYLAYER" "") (SETVAR "CMDECHO" 1) (PRINC))
;;; --------------------------------------------------------------------------
;;; ------------------ LINETYPE SETTING & CHANGE------------------------------
;;; --------------------------------------------------------------------------
(DEFUN C:B1 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "BORDER" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:B2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "BORDER2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:BX2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "BORDERX2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CBB ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. LINETYPE BYLAYER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "BYLAYER" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CEN ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "CENTER" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CE2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "CENTER2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CEX ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "CENTERX2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:CON ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CONTINUOUS: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "CONTINUOUS" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:DAD ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DASHED" "") (PRINC))
(DEFUN C:DA2 ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DASHED2" "") (PRINC))
(DEFUN C:DAX ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DASHEDX2" "") (PRINC))
(DEFUN C:DAT ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DASHDOT" "") (PRINC))
(DEFUN C:DT1 ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DOT" "") (PRINC))
(DEFUN C:DT2 ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DOT2" "") (PRINC))
(DEFUN C:DTX ()
(PRINC "SELECT OBJECT...N")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DOTX2" "") (PRINC))
(DEFUN C:DV1 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DIVIDE" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:DV2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DIVIDE2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:DVX ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "DIVIDEX2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:HD ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE HIDDEN: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "HIDDEN" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:HD2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE HIDDEN2: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "HIDDEN2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:HDX ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE HIDDEN2: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "HIDDENX2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:QHA ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "PHANTOM" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:QH2 ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "PHANTOM2" "") (SETVAR "CMDECHO" 1) (PRINC))
(DEFUN C:QHX ()
(SETVAR "CMDECHO" 0)
(PRINC "SELECT OBJ. BE CENTER: ")
(SETQ SS (SSGET))
(COMMAND "CHPROP" SS "" "LT" "PHANTOMX2" "") (SETVAR "CMDECHO" 1) (PRINC))
;;; -------------------------------------------------------------------------
;;; -------------------------------------------------------------------------
(LOAD "CLOUD")
(LOAD "CHGTEXT")
(LOAD "CHGTXT")
(LOAD "RECSHEET")
这是个圆统计的lsp，主要功能是根据圆孔径值分别标注A B C...识别字符。想请高人帮忙修改一下，增加人工干预功能，在命令行逐行列出圆孔径值，并人为地逐行输入A B C...字符，以区分不同孔径的圆。另外，想让该lsp可以人共输入字符高度。再一个，想让该lsp能筛选同心圆，忽略里面的小圆，只锁定大圆并标以字符。谢谢你！
(defun c:TC()
(princ "\n选择要进行统计的圆对象")
(setq ss (ssget '((0 . "CIRCLE"))) )
(setq pt (getpoint "\n选择输出基点:"))
(setq si 0 tx 65 px (car pt) py (cadr pt) li '() lii 0)
(setq os (getvar "osmode") cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (sslength ss)
(setq cs (ssname ss si) ce (entget cs))
(setq cp (cdr (assoc 10 ce)))
(setq cr (cdr (assoc 40 ce)))
(if (setq lst (assoc cr li))
(setq ct (nth 1 lst) li (subst (list cr ct (1+ (nth 2 lst))) lst li))
(setq ct tx tx (1+ tx) li (cons (list cr ct 1) li))
)
(command "_.text" (polar cp (/ pi 4) (+ cr 1)) 3 0 (chr ct))
(command "_.chprop" "l" "" "p" "c" 6 "")
(setq si (1+ si))
)
(foreach l li
(setq cp (list px (+ py (* lii 5))) )
(setq cr (nth 0 l) ct (nth 1 l) cn (nth 2 l))
(command "_.text" cp 4 0 (strcat (chr ct) ":" (itoa cn) "-%%C" (rtos (* cr 2) 2)))
(command "_.chprop" "l" "" "p" "c" 6 "")
(setq lii (1+ lii))
)
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ "\n统计完成!")
(princ)
)
(DEFUN C:cbj ()
(PRINC "查直径及个数")
(setq ss (ssget '((0 . "CIRCLE"))))
(setq i 0 n 0 zj-j nil cm (getvar "cmdecho"))
(setvar "cmdecho" 0)
(repeat (sslength ss)
(setq el (entget (ssname ss i)))
(setq zj (read (rtos (cdr (assoc 40 el)) 2 4)))
(setq zj-j (cons zj zj-j)) (setq i (1+ i)) )
(setq zj-h (VL-sort zj-j '<) n 1 i 1 zj-hh (reverse zj-h) n1 0)
(while i
(setq zj-n (- (length zj-j) (length (vl-remove-if '(lambda (x) (= x (nth n zj-h))) zj-j))))
(setq n1 (+ zj-n n1) )
(prompt (strcat "直径" (rtos (nth (- zj-n 1) zj-h) 2 4) " " (itoa zj-n) "个"))(terpri)
(setq n n1)
(if (= n1 (length zj-h))(setq i nil))
)
(setvar "cmdecho" cm)
(princ))