home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p053 / install1.img / ACAD_HZ / ACAD.LSP next >
Encoding:
Lisp/Scheme  |  1993-08-27  |  14.5 KB  |  461 lines
  1. (VMON)
  2. (DEFUN C:A   () (COMMAND "ARRAY"))
  3. (DEFUN C:AW  () (COMMAND "ARRAY" "W"))
  4. (DEFUN C:BL  () (COMMAND "BLOCK"))
  5. (DEFUN C:B   () (COMMAND "BREAK"))
  6. (DEFUN C:BB  ()
  7. (setq a (getpoint "\ninput line-point A:"))
  8. (command "osnap" "int")
  9. (setq b (getpoint "\ninput break-point B:"))
  10. (command "osnap" "off")
  11. (command "break" a "f" b "@")
  12. )
  13. (DEFUN C:CH  () (COMMAND "CHANGE"))
  14. (DEFUN C:C   () (COMMAND "COPY"))
  15. (DEFUN C:CW  () (COMMAND "COPY" "W"))
  16. (DEFUN C:CHC () (COMMAND "CHANGE" "L" "" "LA" "CC"))
  17. (DEFUN C:CHQ () (COMMAND "CHANGE" "L" "" "LA" "QC"))
  18. (DEFUN C:CC  () (COMMAND "COPY" "C"))
  19. (DEFUN C:DI  () (COMMAND "DIST"))
  20. (DEFUN C:D   ()
  21.        (command "osnap" "int")
  22.        (setq a (getpoint "INPUT A:"))
  23.        (setq b (getpoint "INPUT B:"))
  24.        (command "osnap" "off")
  25.        (command "dist" a b)
  26. )
  27. (DEFUN C:E   () (COMMAND "ERASE"))
  28. (DEFUN C:EC  () (COMMAND "ERASE" "C"))
  29. (DEFUN C:EW  () (COMMAND "ERASE" "W"))
  30. (DEFUN C:EX  () (COMMAND "EXPLODE"))
  31. (DEFUN C:ET  () (COMMAND "EXTEND"))
  32. (DEFUN C:F   () (COMMAND "FILLET"))
  33. (DEFUN C:IN  () (COMMAND "INSERT"))
  34. (DEFUN C:LM  () (COMMAND "LAYER" "M"))
  35. (DEFUN C:LS  () (COMMAND "LAYER" "S"))
  36. (DEFUN C:L0  () (COMMAND "LAYER" "S" "0" ""))
  37. (DEFUN C:LN  () (COMMAND "LAYER" "N"))
  38. (DEFUN C:L=  () (COMMAND "LAYER" "ON"))
  39. (DEFUN C:L-  () (COMMAND "LAYER" "OFF"))
  40. (DEFUN C:LQ  () (COMMAND "LAYER" "S" "QC" ""))
  41. (DEFUN C:LC  () (COMMAND "LAYER" "S" "CC" ""))
  42. (DEFUN C:L?  () (COMMAND "LAYER" "?" ""))
  43. (DEFUN C:L   () (COMMAND "LINE"))
  44. (DEFUN C:A   () (COMMAND "ARC"))
  45. (DEFUN C:CI  () (COMMAND "CIRCLE"))
  46. (DEFUN C:PL  () (COMMAND "PLINE"))
  47. (DEFUN C:LT  ()
  48. (command "osnap" "int")
  49. (setq a (getpoint "input A:"))
  50. (setq b (getpoint "input B:"))
  51. (command "osnap" "off")
  52. (command "line" a b "")
  53. (redraw))
  54. (DEFUN C:LE  ()
  55. (command "osnap" "end")
  56. (setq a (getpoint "input A:"))
  57. (setq b (getpoint "input B:"))
  58. (command "osnap" "off")
  59. (command "line" a b "")
  60. (redraw))
  61. (DEFUN C:LR  () (COMMAND "LINE" "@"))
  62. (DEFUN C:LTP () (COMMAND "LINETYPE"))
  63. (DEFUN C:LI  () (COMMAND "LIST"))
  64. (DEFUN C:LTS () (COMMAND "LTSCALE"))
  65. (DEFUN C:MN  () (COMMAND "MENU"))
  66. (DEFUN C:MI  () (COMMAND "MIRROR"))
  67. (DEFUN C:M   () (COMMAND "MOVE"))
  68. (DEFUN C:MC  () (COMMAND "MOVE" "C"))
  69. (DEFUN C:MW  () (COMMAND "MOVE" "W"))
  70. (DEFUN C:o   () (COMMAND "offset"))
  71. (DEFUN C:Q   () (COMMAND "QUIT"))
  72. (DEFUN C:R   () (COMMAND "REDRAW"))
  73. (DEFUN C:RO  () (COMMAND "ROTATE"))
  74. (DEFUN C:S   () (COMMAND "SAVE" ""))
  75. (DEFUN C:SC  () (COMMAND "SCALE"))
  76. (DEFUN C:SE  () (COMMAND "SELECT"))
  77. (DEFUN C:S1  () (COMMAND "SHELL"))
  78. (DEFUN C:S2  () (COMMAND "SHELL" ""))
  79. (DEFUN C:STR () (COMMAND "STRETCH" "C"))
  80. (DEFUN C:STY () (COMMAND "STYLE"))
  81. (DEFUN C:T   () (COMMAND "TEXT"))
  82. (DEFUN C:TC  () (COMMAND "TRACE"))
  83. (DEFUN C:TR  () (COMMAND "TRIM"))
  84. (DEFUN C:EP  () (COMMAND "EXPLODE"))
  85. (DEFUN C:V   () (COMMAND "VIEW"))
  86. (DEFUN C:W   () (COMMAND "WBLOCK"))
  87. (DEFUN C:Z   () (COMMAND "ZOOM"))
  88. (DEFUN C:ZP  () (COMMAND "ZOOM" "P"))
  89. (DEFUN C:ZZ  () (COMMAND "ZOOM" "P"))
  90. (DEFUN C:ZW  () (COMMAND "ZOOM" "W"))
  91. (DEFUN C:ZE  () (COMMAND "ZOOM" "E"))
  92. (DEFUN C:CX ()
  93. (COMMAND "OSNAP" "INT")
  94. (SETQ A (GETPOINT "\nPlease input point:"))
  95. (COMMAND "OSNAP" "OFF")
  96. (setq b (getdist "\nPlease input BI-LI<100>:"))
  97. (if (= b nil) (setq b 100))
  98. (SETQ XX (- (CAR A) (* b 0.7)))
  99. (SETQ XY (- (CADR A) (* b 0.7)))
  100. (SETQ YX (+ (CAR A) (* b 0.7)))
  101. (SETQ YY (+ (CADR A) (* b 0.7)))
  102. (SETQ X (LIST XX XY))
  103. (SETQ Y (LIST YX YY))
  104. (COMMAND "LINE" X Y "")
  105. )
  106. (defun c:jx ()
  107. (setq x (getreal "input  x  "))
  108. (setq y (getreal "input  y  "))
  109. (setq p1 (getpoint "input a point:  "))
  110. (setq p2 (list (+ (car p1) x)(cadr p1)))
  111. (setq p3 (list (car p2)(+ (cadr p2) y)))
  112. (setq p4 (list (car p1)(cadr p3)))
  113. (command "line" p1 p2 p3 p4 "c" ^c)
  114. (command "redraw")
  115. )
  116. (defun c:c1 ()
  117. (setq y (getstring "y="))
  118. (setq p (getpoint "select object"))
  119. (command "copy"\0,0 @0,y)
  120. )
  121. (DEFUN C:1 ()
  122. (COMMAND "OSNAP" "END")
  123. (setq p1 (getpoint "p1:"))
  124. (COMMAND "OSNAP" "OFF")
  125. (setq p1 (list (car p1)(- (cadr p1) 5)))
  126. (COMMAND "circle" p1 "5" )
  127. (COMMAND "text" "M" P1 "4" "0")
  128. )
  129. (DEFUN C:2 ()
  130. (COMMAND "OSNAP" "END")
  131. (setq p1 (getpoint "p1:"))
  132. (COMMAND "OSNAP" "OFF")
  133. (setq p2 (list (- (car p1) 5)(cadr p1)))
  134. (COMMAND "circle" p2 "5" )
  135. (COMMAND "text" "M" P2 "4" "0" )
  136. )
  137. (DEFUN C:3 ()
  138. (COMMAND "osnap" "end" )
  139. (setq p1 (getpoint "p:"))
  140. (COMMAND "osnap" "OFF" )
  141. (SETQ TEXT1 (GETSTRING "TEXT1:" ))
  142. (SETQ TEXT2 (GETSTRING "TEXT2:" ))
  143. (setq p2 (list (car p1)(- (cadr p1) 5)))
  144. (setq p3 (list (- (car p1) 2)(- (cadr p1) 3)))
  145. (setq p4 (list (+ (car p1) 1.7)(- (cadr p1) 7)))
  146. (setq p5 (polar p2 (* pi 1.25) 5))
  147. (setq p6 (polar p5 (/ pi 4) 10))
  148. (COMMAND "circle" P2 "5" )
  149. (COMMAND "text" "M" P3 "3" "0" TEXT1 )
  150. (COMMAND "text" "M" P4 "3" "0" TEXT2 )
  151. (COMMAND "line" P5 P6 ^C)
  152. )
  153. (DEFUN C:4 ()
  154. (COMMAND "osnap" "end" )
  155. (setq p1 (getpoint "p:"))
  156. (COMMAND "osnap" "OFF" )
  157. (SETQ TEXT1 (GETSTRING "TEXT1:" ))
  158. (SETQ TEXT2 (GETSTRING "TEXT2:" ))
  159. (SETQ P2 (LIST (- (CAR P1) 5)(CADR P1)))
  160. (SETQ P3 (LIST (- (CAR P1) 7)(+ (CADR P1) 2)))
  161. (SETQ P4 (LIST (- (CAR P1) 3.5)(- (CADR P1) 2)))
  162. (SETQ P5 (POLAR P2 (* PI 1.25) 5))
  163. (SETQ P6 (POLAR P5 (/ PI 4) 10))
  164. (COMMAND "circle" P2 "5" )
  165. (COMMAND "text" "M" P3 "3" "0" TEXT1 )
  166. (COMMAND "text" "M" P4 "3" "0" TEXT2 )
  167. (COMMAND "line" P5 P6 ^C)
  168. )
  169. (DEFUN C:P   () (COMMAND "PAN"))
  170. (defun MODES (a)
  171.    (setq MLST '())
  172.    (repeat (length a)
  173.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  174.       (setq a (cdr a))
  175.    )
  176. )
  177. (defun MODER ()
  178.    (repeat (length MLST)
  179.       (setvar (caar MLST) (cadar MLST))
  180.       (setq MLST (cdr MLST))
  181.    )
  182. )
  183. (defun myerror (st)
  184.    (if (/= st "Function cancelled")
  185.        (princ (strcat "\nError: " st))
  186.    )
  187.    (moder)
  188.    (setq *error* olderr)
  189.    (princ)
  190. )
  191. (defun RTD (y)
  192.    (* 180. (/ y pi))
  193. )
  194. (defun DTR (y)
  195.    (* pi (/ y 180.))
  196. )
  197. (defun C:CTEXT ()
  198.    (setvar "BLIPMODE" 0)
  199.    (setvar "CMDECHO" 0)
  200.    (modes '("BLIPMODE" "CMDECHO"))
  201.    (graphscr)
  202.    (princ "Please select HZ style:")
  203.    (initget 2 "Singleline-hz Doubleline-hz")
  204.    (setq hz (getstring "\nSingleline-hz/Doubleline-hz/<standard-hz>:"))
  205.    (cond ((eq hz "s")  (COMMAND "STYLE" "HZ" "TXT,HZTXT" "" "0.75" "" "" ""))
  206.          ((eq hz "d")  (COMMAND "STYLE" "HZ1" "TXT,HZTXT1" "" "0.75" "" "" ""))
  207.          ((eq hz "") (COMMAND "STYLE" "HZ0" "TXT,HZTXT0" "" "0.75" "" "" ""))
  208.          (T (princ "Unknown HZ style !"))
  209.          )
  210.    (setq cst (getvar "textstyle"))
  211.     (if (= interface nul) (setq interface "P"))
  212.     (if (or (= interface "W") (= interface "w"))
  213.         (princ "\nCurrent Interface is WBX")
  214.         (princ "\nCurrent Interface is Py.")
  215.     )
  216.    (setq olderr *error*
  217.          *error* myerror)
  218.    (modes '("BLIPMODE" "CMDECHO"))
  219.    (graphscr)
  220.    (initget 1 "Center Fit Middle Right Interface")
  221.    (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right/Interface :"))
  222.    (if (/= (type pt) 'LIST)
  223.       (if (= pt "Interface")
  224.          (progn
  225.               (initget  "Wbx Py")
  226.               (setq interfaces (getkword  "\n Wbx or Py :"))
  227.               (setq interface (substr interfaces 1 1))
  228.               (setq pt (getpoint "\n<Start point or Center>/Fit/Middle/Right:"))
  229.            )
  230.       )
  231.    )
  232.    (if (/= (type pt) 'LIST)
  233.        (setq j (substr pt 1 1))
  234.        (setq j "L")
  235.    )
  236.  
  237.    (if (/= (type pt) 'LIST)
  238.        (if (= pt "Fit")
  239.            (progn
  240.               (initget 1)
  241.               (setq ptf (getpoint "Fist text line point: "))
  242.               (setq pt ptf)
  243.               (initget 1)
  244.               (setq pts (getpoint "Second text line point: "))
  245.               (setq k 1)
  246.            )
  247.            (progn
  248.               (initget 1)
  249.               (setq pt (getpoint (strcat "\n" pt " point: ")))
  250.            )
  251.        )
  252.   )
  253.   (initget 6)
  254.   (setq h (getdist pt (strcat "\nHeight <"
  255.                               (rtos (getvar "TEXTSIZE"))
  256.                                 ">: "
  257.                       )
  258.           )
  259.    )
  260.    (if (null h) (setq h (getvar "textsize")))
  261.    (if (/= k 1)
  262.     (progn
  263.      (if (null a$$)
  264.          (progn
  265.            (if (= (cdr (assoc 70 ts)) 4)   ;Vertical style text
  266.                (progn
  267.                  (setq a$$ 270)
  268.                  (prompt "\nRotational angle <270>: ")
  269.                )
  270.                (progn
  271.                  (setq a$$ 0)
  272.                  (prompt "\nRotational angle <0>: ")
  273.                )
  274.            )
  275.          )
  276.          (progn
  277.            (prompt "\nRotational angle <")
  278.            (princ (strcat (angtos a$$) ">: "))
  279.          )
  280.      )
  281.      (setq ang (getangle pt))
  282.      (if (null ang) (setq ang a$$))
  283.      (setq a$$ ang)
  284.     )
  285.    )
  286.   (if (or (= interface "P") (= interface "p")) (command "AVCAD")(command "AVCAD W"))
  287.   (setq f (open "chstr.dat" "r"))
  288.   (setq eoff 1)
  289.   (setq st (read-line f))
  290.   (cond ((and (= j "L") h)
  291.            (while (= eoff 1)
  292.                 (command "TEXT" "s" cst pt h (rtd ang) st)
  293.                 (setq OLDx (car pt))
  294.                 (setq oldy (cadr pt))
  295.                 (setq newX (+ oldX (* (sin ANG) H (/ 1. 0.6))))
  296.                 (setq newy (- oldy (* (cos ANG) H (/ 1. 0.6))))
  297.                 (setq pt (list NEWX NEWY))
  298.                 (setq st (read-line f))
  299.                 (if (= st   nil)(setq eoff 2))
  300.              )
  301.          )
  302.          ((and (/= j "L") (/= j "F") h)
  303.           (command "TEXT" "s" cst j pt h (rtd ang) st)
  304.          )
  305.          ((and (/= j "L") (= j "F") h)
  306.           (command "TEXT" "s" cst j ptf pts h st)
  307.          )
  308.       )
  309.    (moder)
  310.    (setq *error* olderr)
  311.    (close f)
  312.    (command "text" "s" cst ^c)
  313.    (redraw)
  314.    (princ)
  315. )
  316.  
  317.  
  318. (defun C:EPT (/ olds oldss olds1 stp h txt wf st x0 y0 l n yes
  319.                 TXTA TXT1 NN AR AD CL cst)
  320.    (setq olderr *error*
  321.          *error* myerror)
  322.    (setvar "BLIPMODE" 0)
  323.    (setvar "CMDECHO" 0)
  324.    (SETQ CL (GETVAR "CLAYER"))
  325.    (setq cst (getvar "textstyle"))
  326.    (setq olds (entsel "\nSelect the string :"))
  327.    (SETQ OLDSS (CAR OLDS))
  328.    (setq olds (entget  (car  olds)))
  329.    (setq olds1 (cdr (assoc 0 olds)))
  330.    (if (= "TEXT" oldS1)
  331.        ( progn
  332.           (COMMAND "ERASE" (SSADD OLDSS) "")
  333.           (COMMAND "LAYER" "S"  (CDR (ASSOC 8 OLDS)) "")
  334.           (setq stp  (trans (cdr (assoc 10 olds)) 0 1))
  335.           (setq h   (cdr (assoc 40 olds)))
  336.           (setq aR (cdr (assoc 50 olds)))
  337.           (setq aD  (RTD (cdr (assoc 50 olds))))
  338.           (setq txt (cdr (assoc 1 olds)))
  339.           (setq wf (Cdr (assoc 41 olds)))
  340.           (SETQ ST (CDR (ASSOC 7 OLDS)))
  341.           (SETQ X0 (CAR STP) Y0 (CADR STP))
  342.           (setq l (strlen txt))
  343.           (setq n 1) (setq nn 2)
  344.           (setq yes 1)
  345.           (while (<= N L)
  346.                   (setq tXT1 (substr txt n 2))
  347.                   (SETQ TXTA (ASCII TXT1))
  348.                   (setq nn (cond
  349.                             ((= TXT1 "%%") 3)
  350.                             ((> Txta 160) 2)
  351.                             ((< Txta 129) 1)
  352.                            )
  353.                   )
  354.                   (setq txt1 (substr txt n nn))
  355.                   (setq n (+ n nn))
  356.                   (command "text" "S" ST stp h aD txt1)
  357.  
  358.                   (IF (= NN 2)
  359.                       (PROGN
  360.                          (cond ((eq cst "HZ")   (setq wscale 1.0625))
  361.                                ((eq cst "HZ1")  (setq wscale 1.20))
  362.                                ((eq cst "HZ0")  (setq wscale 1.40))
  363.                               )
  364.                          (SETQ X0 (+ X0 (* (cos aR)  H WF wscale)))
  365.                          (SETQ y0 (+ Y0 (* (sin aR)  H WF wscale)))
  366.                       )
  367.                       (PROGN
  368.                          (SETQ JF (COND
  369.                                      ((= TXTA 49) 0.65)
  370.                                      ((= TXTA 46) 0.3)
  371.                                      (T 1)
  372.                                   )
  373.                           )
  374.                          (setq wf1 (* JF WF))
  375.                          (SETQ X0 (+ X0 (* (cos aR)  H WF1)))
  376.                          (SETQ y0 (+ Y0 (* (sin aR)  H WF1)))
  377.                       )
  378.                    )
  379.                   (SETQ STP (LIST X0 Y0))
  380.  
  381.          )
  382.      )
  383.   )
  384.  (COMMAND "LAYER" "S" CL "")
  385.   (command "text" "s" cst ^c)
  386.  (setq *error* olderr)
  387.  (princ)
  388. )
  389.  
  390. (DEFUN C:HZFILE(/ TXT SP TH INS WD STL LS DT)
  391. (setvar "BLIPMODE" 0)
  392. (SETVAR "CMDECHO" 0)
  393. (modes '("BLIPMODE" "CMDECHO"))
  394. (graphscr)
  395. (SETQ TXT (OPEN (GETSTRING "\n Name of Text File(WordStar): ") "r"))
  396. (SETQ SP (GETPOINT "\n Text String Start Point :"))
  397. (SETQ INS (GETSTRING"\n Enter Line Spacing in Drawing Units :"))
  398. (SETQ HT (GETSTRING "\n Enter Text Height in Drawing Units :"))
  399. (SETQ WD (GETSTRING "\n Enter Text Width Factor :"))
  400. (princ "Please select HZ style:")
  401. (initget 2 "Singleline-hz Doubleline-hz")
  402. (setq hz (getstring "\nSingleline-hz/Doubleline-hz/<standard-hz>:"))
  403. (setq pname (getvar "dwgprefix"))
  404. (cond ((eq hz "s")  (COMMAND "STYLE" "HZ" "txt,hztxt" HT WD "" "" ""))
  405.       ((eq hz "d")  (COMMAND "STYLE" "HZ1" "txt,hztxt1" HT WD "" "" ""))
  406.       ((eq hz "")   (COMMAND "STYLE" "HZ0" "txt,hztxt0" HT WD "" "" ""))
  407.       (T (princ "Unknown HZ style ! Restart HZFILE command."))
  408.       )
  409.  
  410. (SETQ DT (READ-LINE TXT))
  411. (SETQ LS (STRCAT "@"INS"<-90"))
  412. (COMMAND"TEXT" SP "" DT)
  413. (WHILE (/= DT NIL)
  414. (SETQ DT (READ-LINE TXT))
  415. (COMMAND"TEXT" LS "" DT)
  416. )
  417. (COMMAND"REDRAW")
  418. )
  419.  
  420. ; For other Autolisp aplication
  421. (DEFUN C:BOX () (LOAD "BOX")(C:BOX))
  422. (DEFUN C:MXB () (LOAD "MXB")(C:MXB))
  423. (DEFUN C:CL  () (LOAD "CL")(C:CL))
  424. (DEFUN C:TH () (LOAD "TH")(C:TH))
  425. (DEFUN C:LD  () (LOAD "LEADER")(C:LD))
  426. (DEFUN C:CHGTEXT () (LOAD "CHGTEXT")(C:CHGTEXT))
  427. (DEFUN C:LTEXT ()  (LOAD "LTEXT")(C:LTEXT))
  428. (DEFUN C:LEXPLODE ()  (LOAD "LEXPLODE")(C:LEXPLODE))
  429. (DEFUN SSX () (LOAD "SSX")(SSX))
  430.  
  431. ;Setup environment
  432. (DEFUN C:ENVIRON () (LOAD "ENVIRON")(C:ENVIRON))
  433.  
  434.  
  435. ;For clean memery
  436. (defun C:CLEAN () (SETQ ATOMLIST (MEMBER 'C:CLEAN ATOMLIST)))
  437.  
  438. ;For ctext, box ,mxb, ld ,...
  439. (DEFUN S::STARTUP ()
  440.    (setvar "cmdecho" 0)
  441.    (setvar "blipmode" 0)
  442.  
  443.   (IF (= (TBLSEARCH "STYLE" "A") NUL) 
  444.        (COMMAND "STYLE" "A" "COMPLEX" "6" "0.8" "" "" "" ""))
  445.   (IF (= (TBLSEARCH "STYLE" "HZ") NUL)
  446.       (COMMAND "STYLE" "HZ" "TXT,HZTXT" "" "0.75" "" "" ""))
  447.   (IF (= (TBLSEARCH "STYLE" "ASC") NUL)
  448.       (COMMAND "STYLE" "ASC" "TXT" "" "0.75" "" "" "" ""))
  449.   (IF (= (TBLSEARCH "LAYER" "1") NUL)
  450.       (COMMAND "LAYER" "N" "1" "C" "1" "1" "LT" "CENTER" "1" ""))
  451.   (IF (= (TBLSEARCH "LAYER" "4") NUL)
  452.       (COMMAND "LAYER" "N" "4" "C" "4" "4" "LT" "" "1" ""))
  453.   (IF (= (TBLSEARCH "LAYER" "5") NUL)
  454.       (COMMAND "LAYER" "N" "5" "C" "6" "5" "LT" "" "5" ""))
  455.  
  456.   (setvar "textsize" 4.8)
  457.    (princ)
  458.  )
  459. ;
  460. (princ)
  461.