[求助]：希望高手帮忙修改一下源码

HLB_Konan

小弟是做结构的 用的一些lsp程序 但感觉这些程序对绘图环境要求很苛刻 只能用他的初始化
程序后 才能用这些程序 我希望高手帮忙改下 能够适合通常环境 下面3个程序 分别是画节点时直接偏移成钢筋 还有画板钢筋时的负筋 底筋 希望高手帮忙 先谢过了
(defun c:gj( / a1 ss si i ssl pt pt1 pt2 p1 p2 ts d cla os)
  (setvar "CMDECHO" 0)
  (setq d (getvar "BLIPMODE") cla (getvar "clayer") os (getvar "osmode"))
  (setvar "BLIPMODE" 0)
  (setvar "osmode" 0)
  (setq ts (* 0.8 bl))
  (princ "\nSelect an line to get GJ: ")
  (setq ss (ssget))
  (if ss
    (progn
      (setq pt (getpoint "\nDirection Point:") i 0)
      (repeat (sslength ss)
        (setq si (ssname ss i) i (1+ i) ssl (entget si))
        (if (= (cdr (assoc 0 ssl)) "LINE")
          (progn
            (setq pt1 (cdr (assoc 10 ssl))
                  pt2 (cdr (assoc 11 ssl))
                  a1 (angle pt1 pt2)
                  p1 (polar pt1 (+ a1 (* 0.5 pi)) ts)
                  p2 (polar pt1 (- a1 (* 0.5 pi)) ts)
            )
            (if (> (distance p1 pt) (distance p2 pt)) (setq p1 p2))
            (setq p2 (polar pt2 (angle pt1 p1) ts)
                  p1 (polar p1 a1 ts)
                  p2 (polar p2 (+ a1 pi) ts)
            )
            (setvar "clayer" "r0")
            (command "line" p1 p2 "")
          ) ;progn
        ) ;if
      ) ;repeat
    ) ;progn
    (princ "\nSelect is Empty!")
  ) ;if
  (setvar "BLIPMODE" d)
  (setvar "clayer" cla)
  (setvar "osmode" os)
  (princ)
)

(defun c:fj( / os pt1 pt2 pt3 pt4 pt5 pt6 l1 l2 cula an s1 s2)
  (setq os (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setq te (getvar "textstyle"))
  (setvar "osmode" 512)
  (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))
  (setvar "osmode" 128)
  (setq pt2 (getpoint pt1 "\nPick the second point:"))
  (setvar "osmode" 128)
  (setq l1 (getdist pt1 "\nEnter first length <0.0>: "))
  (if (= l1 nil) (setq l1 0.0))
  (if (< l1 -0.01)
    (setq l1 (* -1.0 l1))
    (if (> l1 0.01)
      (progn
        (setq l1 (* (1+ (fix (/ (* 0.25 l1) 50.0))) 50))
        (if (< l1 700.0) (setq l1 700.0))
      )
    )
  )
  (setq l2 (getdist pt2 "\nEnter second length <0.0>: "))
  (if (= l2 nil) (setq l2 0.0))
  (if (< l2 -0.01)
    (setq l2 (* -1.0 l2))
    (if (> l2 0.01)
      (progn
        (setq l2 (* (1+ (fix (/ (* 0.25 l2) 50.0))) 50))
        (if (< l2 700.0) (setq l2 700.0))
      )
    )
  )
  (setvar "osmode" 0)
  (setq an (angle pt1 pt2))
  (if (> l1 0.01)
    (setq pt3 (polar pt1 (+ an 3.1415926) l1) s1 (rtos l1 2 0))
    (setq pt3 (polar pt1 an (* 0.5 bl)) a1 "")
  )
  (if (> l2 0.01)
    (setq pt4 (polar pt2 an l2) s2 (rtos l2 2 0))
    (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 bl)) s2 "")
  )
  (setq pt5 (polar pt3 (- an 1.570796) (* 2.5 bl)))
  (setq pt6 (polar pt4 (- an 1.570796) (* 2.5 bl)))
  (setq cula (getvar "clayer"))
  (command "layer" "m" "r0" "")
  (command "line" pt5 pt3 pt4 pt6 "")
  (if (> l1 0.01)
    (progn
      (setq pt5 (list (* 0.5 (+ (car pt1) (car pt3)))
                      (* 0.5 (+ (cadr pt1) (cadr pt3)))))
      (if (< an pi)
        (setq pt5 (polar pt5 (- an (* 0.5 pi)) (* 1.8 bl)))
        (setq pt5 (polar pt5 (+ an (* 0.5 pi)) (* 1.8 bl)))
      )
      (command "layer" "m" "dt" "")
      (setvar "textstyle" "tz")
      (command "text" "mc" pt5 (* 2.0 bl) (angtos an 0 4) s1)
    )
  )
  (if (> l2 0.01)
    (progn
      (setq pt6 (list (* 0.5 (+ (car pt2) (car pt4)))
                      (* 0.5 (+ (cadr pt2) (cadr pt4)))))
      (if (< an pi)
        (setq pt6 (polar pt6 (- an (* 0.5 pi)) (* 1.8 bl)))
        (setq pt6 (polar pt6 (+ an (* 0.5 pi)) (* 1.8 bl)))
      )
      (command "layer" "m" "dt" "")
      (setvar "textstyle" "tz")
      (command "text" "mc" pt6 (* 2.0 bl) (angtos an 0 4) s2)
    )
  )
  (setvar "textstyle" te)
  (setvar "clayer" cula)
  (setvar "osmode" os)
  (princ)
)

(defun c:dj( / os pt1 pt2 pt3 pt4 cula an)
  (setq os (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)
  (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))
  (setvar "osmode" 128)
  (setq pt2 (getpoint pt1 "\nPick the second point:"))
  (setvar "osmode" 0)
  (setq an (angle pt1 pt2))
  (setq pt3 (polar pt1 an (* 0.5 bl)))
  (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 bl)))
  (setq cula (getvar "clayer") an (/ (* an 180) 3.1415926))
  (command "layer" "s" "r0" "")
  (command "line" pt3 pt4 "")
  (command "insert" "g2" pt3 blx blx an)
  (command "insert" "g2m" pt4 blx blx an)
  (command "layer" "s" cula "")
  (setvar "osmode" os)
  (princ)
)

;(defun calp (pt1 pt2 d / p lmd)
;  (setq lmd (/ d (distance pt1 pt2)))
;  (setq p (mapcar '+ pt1 (mapcar '* (list lmd lmd) (mapcar '- pt2 pt1))))
;)

(defun trn(s1 / s0 s2 n0 j)
  (setq s0 "" j 1)
  (while (<= j (strlen s1))
    (setq s2 (substr s1 j 1))
    (if (= s2 "-")
      (setq s0 (strcat s0 "%%130"))
      (if (= s2 "+")
        (setq s0 (strcat s0 "%%131"))
        (if (= s2 "*")
          (setq s0 (strcat s0 "x"))
          (setq s0 (strcat s0 s2))
        )
      )
    )
    (setq j (1+ j))
  )
  (setq s2 s0)
)

(defun c:j1() (j12 1))
(defun c:j2() (j12 2))

(defun j12(n12 / x y b a0 a1 a2 cm bi os ln ent entlist na pt pt1 pt2 lay)
  (setq cm (getvar "cmdecho"))
  (setq bi (getvar "blipmode"))
  (setq os (getvar "osmode"))
  (setq ln (getvar "CLAYER"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (if (= n12 1) (setq bna1 "g1" bna2 "g1m")
                (setq bna1 "g2" bna2 "g2m")
  )
  (prompt "\nPick a line: ")
  (setq ent (entsel))
  (setq entlist (entget (car ent)))
  (setq na (cdr (assoc 0 entlist)))
  (setq b (/ bl 100.0))
  (if (= na "LINE")
    (progn
      (setq pt1 (cdr (assoc 10 entlist)))
      (setq pt2 (cdr (assoc 11 entlist)))
      (setq lay (cdr (assoc 8 entlist)))
      (initget 1)
      (setq pt (getpoint "\nPick a point to direct:"))
      (setq y (< (distance pt1 pt) (distance pt2 pt)))
      (setvar "clayer" lay)
      (setq a1 (angle pt1 pt2) a2 (angle pt2 pt1) a0 (angle pt1 pt))
      (setq x (- a1 a0))
      (if (< x 0.0) (setq x (+ (* 2.0 pi) x)))
      (if (or (< x pi))
        (if y
          (command "insert" bna2 pt1 b b (/ (* 180 a2) pi))
          (command "insert" bna1 pt2 b b (/ (* 180 a2) pi))
        )
        (if y
          (command "insert" bna1 pt1 b b (/ (* 180 a1) pi))
          (command "insert" bna2 pt2 b b (/ (* 180 a1) pi))
        )
      )
    )
    (princ "\nSelect is not a line!")
  )
  (setvar "cmdecho" cm)
  (setvar "blipmode" bi)
  (setvar "osmode" os)
  (setvar "CLAYER" ln)
  (princ)
)

(defun c:jt( / bi os ln ent entlist na pt0 pt1 pt2 pt3)
  (setq bi (getvar "blipmode"))
  (setq os (getvar "osmode"))
  (setq ln (getvar "CLAYER"))
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode" 0)
  (prompt "\nPick a line: ")
  (if (setq ent (entsel))
    (progn
      (setq pt0 (cadr ent))
      (setq entlist (entget (car ent)))
      (setq na (cdr (assoc 0 entlist)))
      (if (= na "LINE")
        (progn
          (setq pt1 (cdr (assoc 10 entlist)))
          (setq pt2 (cdr (assoc 11 entlist)))
          (setvar "clayer" "D0")
          (if (> (distance pt1 pt0) (distance pt2 pt0))
            (setq pt3 pt1 pt1 pt2 pt2 pt3)
          )
          (setq pt3 (polar pt1 (angle pt1 pt2) (* bl 3.5)))
          (command "pline" pt1 "w" "0" (* 0.8 bl) pt3 "")
        )
        (princ "\nSelect is not a line!")
      )
    )
    (princ "\nSelect is empty!")
  )
  (setvar "blipmode" bi)
  (setvar "osmode" os)
  (setvar "CLAYER" ln)
  (princ)
)

(defun c:g( / la os tes ss s pt0 pt1 pt2 pt3 pt4 x1 y1 x2 y2 ang p r h)
  (setvar "cmdecho" 0)
  (setq la (getvar "clayer"))
  (setq os (getvar "osmode") r (* 2.5 bl) h (* 2.25 bl))
  (setq tes (getvar "textstyle"))
  (setvar "osmode" 0)
  (if (= gna nil) (setq gna 1))
  (setq s (entsel "\nPick the GJ_line:"))
  (if s
    (progn
      (setq pt0 (cadr s) s (car s))
      (redraw s 3)
      (setq ss (entget s))
      (if (= (cdr (assoc 0 ss)) "LINE")
        (progn
          (setq pt0 (osnap pt0 "Nearest"))
          (setq pt1 (cdr (assoc 10 ss)))
          (setq pt2 (cdr (assoc 11 ss)))
          (setq x1 (car pt1) y1 (cadr pt1) x2 (car pt2) y2 (cadr pt2))
          (if (not (or (and (< (abs (- x1 x2)) 0.00001) (< y1 y2))
                       (< x1 x2)))
            (setq p pt2 pt2 pt1 pt1 p)
          )
          (setq ang (angle pt1 pt2))
          (initget 1)
          (setq pt3 (getpoint pt0 "\nPick the directive point:"))
          (setq p (- (angle pt1 pt3) ang))
          (if (< p 0.0) (setq p (+ (* 2.0 pi) p)))
          (if (< p pi)
            (setq pt4 (polar pt0 (+ ang (* 0.5 pi)) r))
            (setq pt4 (polar pt0 (- ang (* 0.5 pi)) r))
          )
;          (setq gna (1+ gna))
          (setq pt0 (getint (strcat "\nG_name: <" (itoa gna) "> ")))
          (if (/= pt0 nil) (setq gna pt0))
          (setvar "textstyle" "tz")
          (command "layer" "m" "dt" "")
          (command "circle" pt4 r)
          (command "text" "m" pt4 h (/ (* 180.0 ang) pi) (itoa gna))
        ) ;progn
        (princ "\nPlease select a GJ_line!")
      ) ;if
      (redraw s 4)
    ) ;progn
    (princ "\nPlease select a entity!")
  ) ; if ss
  (setvar "textstyle" tes)
  (setvar "osmode" os)
  (setvar "clayer" la)
  (princ)
) ;end g

(defun c:xx( / os la l1 es pt1 pt2 pt3 pt4 pt an ss s n i)
  (setq os (getvar "osmode"))
  (setvar "cmdecho" 0)
  (setq la (getvar "clayer"))
  (setvar "osmode" 0)
  (setq l1 (entsel "Pick first line:"))
  (if l1
    (if (/= (cdr (assoc 0 (entget (car l1)))) "LINE") (setq l1 nil))
  )
  (if l1
    (progn
      (setq l1 (car l1) es (entget l1))
      (redraw l1 3)
      (setq pt1 (cdr (assoc 10 es)))
      (setq pt2 (cdr (assoc 11 es)))
      (setq an (angle pt1 pt2))
      (setq ss (ssget))
      (setq n (sslength ss) i 0)
      (setvar "clayer" "D0")
      (repeat n
        (setq s (ssname ss i) i (1+ i))
        (setq es (entget s))
        (if (= (cdr (assoc 0 es)) "LINE")
          (progn
            (setq pt3 (cdr (assoc 10 es)))
            (setq pt4 (cdr (assoc 11 es)))
            (setq pt (inters pt1 pt2 pt3 pt4))
            (if pt
              (command "insert" "G3" pt (/ bl 100) "" (/ (* an 180) pi))
            ) ;if
          ) ;progn
        ) ;if
      ) ;repeat
      (redraw l1 4)
    ) ;progn
  ) ;if
  (setvar "clayer" la)
  (setvar "osmode" os)
  (princ)
)

(defun c:dt( / pt1 pt2 an osm str pe)
  (setvar "cmdecho" 0)
  (setvar "orthomode" 1)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (if (= dis nil) (setq dis 200.0))
  (setq pe t)
  (while (/= pe nil)
    (setq str (strcat "\nDistance{ " (rtos dis 2 0) " }/<Exit>/First point:"))
    (initget "Distance Exit")
    (setq pt0 (getpoint str))
    (cond
      ((= pt0 nil) (setq pe nil))
      ((= pt0 "Exit") (setq pe nil))
      ((= pt0 "Distance") (setq dis (getdist "\nDistance:")))
      (t (progn
           (setq pt1 (getcorner pt0 "\nSecond point:"))
           (command "stretch" "c" pt0 pt1 "")
           (setq pt2 (getpoint pt1 "\nDirecte point:"))
           (setq an (angtos (angle pt1 pt2) 0 2))
           (command pt1 (strcat "@" (rtos dis 2 1) "<" an))
         )
      )
    )
  )
  (setvar "osmode" osm)
  (princ)
)

(defun c:mo( / wd pt0 pt1 an osm str pe)
  (setvar "cmdecho" 0)
  (setvar "orthomode" 1)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 0)
  (if (= dis nil) (setq dis 200.0))
  (setq pe t)
  (while (/= pe nil)
    (setq str (strcat "\nDistance{ " (rtos dis 2 0) " }/Exit/<Select>:"))
    (initget "Distance Exit Select")
    (setq wd (getkword str))
    (cond
      ((= wd "Exit") (setq pe nil))
      ((= wd "Distance") (setq dis (getdist "\nDistance:")))
      (t (progn
           (setq str (ssget))
           (if str
             (progn
               (setq pt0 (getpoint "\nFirst point:"))
               (setq pt1 (getpoint pt0 "\nDirecte point:"))
               (setq an (angtos (angle pt0 pt1) 0 2))
               (command "move" str "" pt0 (strcat "@" (rtos dis 2 1) "<" an))
             )
           )
         )
      )
    )
  )
  (setvar "osmode" osm)
  (princ)
)

xyp1964

文件测试：

2. [FONT=courier new];;钢筋、负筋、底筋
   
3. (defun c:gj (/ a1 ss si i ssl pt pt1 pt2 p1 p2 ts d cla os)
   
4.   (if (null no1)
   
5.     (setq no1 100.0)
   
6.   )
   
7.   (setq        no1 (UREAL 7 "" "\n比例" no1)
   
8.         d   (getvar "BLIPMODE")
   
9.         cla (getvar "clayer")
   
10.         os  (getvar "osmode")
    
11.         s   (* 0.8 no1)
    
12.   )
    
13.   (setvar "CMDECHO" 0)
    
14.   (setvar "BLIPMODE" 0)
    
15.   (setvar "osmode" 0)
    
16.   (princ "\nSelect an line to get GJ: ")
    
17.   (setq ss (ssget))
    
18.   (if ss
    
19.     (progn
    
20.       (setq pt (getpoint "\nDirection Point:")
    
21.             i  0
    
22.       )
    
23.       (repeat (sslength ss)
    
24.         (setq si  (ssname ss i)
    
25.               i          (1+ i)
    
26.               ssl (entget si)
    
27.         )
    
28.         (if (= (cdr (assoc 0 ssl)) "LINE")
    
29.           (progn
    
30.             (setq pt1 (cdr (assoc 10 ssl))
    
31.                   pt2 (cdr (assoc 11 ssl))
    
32.                   a1  (angle pt1 pt2)
    
33.                   p1  (polar pt1 (+ a1 (* 0.5 pi)) ts)
    
34.                   p2  (polar pt1 (- a1 (* 0.5 pi)) ts)
    
35.             )
    
36.             (if        (> (distance p1 pt) (distance p2 pt))
    
37.               (setq p1 p2)
    
38.             )
    
39.             (setq p2 (polar pt2 (angle pt1 p1) ts)
    
40.                   p1 (polar p1 a1 ts)
    
41.                   p2 (polar p2 (+ a1 pi) ts)
    
42.             )
    
43.             (command "layer" "m" "r0" "c" "1" "" "")
    
44.             (command "line" p1 p2 "")
    
45.           )
    
46.         )
    
47.       )
    
48.     )
    
49.     (princ "\nSelect is Empty!")
    
50.   )
    
51.   (setvar "BLIPMODE" d)
    
52.   (setvar "clayer" cla)
    
53.   (setvar "osmode" os)
    
54.   (princ)
    
55. )
    
56. 
    
57. (defun c:fj (/ os pt1 pt2 pt3 pt4 pt5 pt6 l1 l2 cula an s1 s2)
    
58.   (if (null no1)
    
59.     (setq no1 100.0)
    
60.   )
    
61.   (setq        no1 (UREAL 7 "" "\n比例" no1)
    
62.         os  (getvar "osmode")
    
63.   )
    
64.   (setvar "cmdecho" 0)
    
65.   (setq te (getvar "textstyle"))
    
66.   (setvar "osmode" 512)
    
67.   (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))
    
68.   (setvar "osmode" 128)
    
69.   (setq pt2 (getpoint pt1 "\nPick the second point:"))
    
70.   (setvar "osmode" 128)
    
71.   (setq l1 (getdist pt1 "\nEnter first length <0.0>: "))
    
72.   (if (= l1 nil)
    
73.     (setq l1 0.0)
    
74.   )
    
75.   (if (< l1 -0.01)
    
76.     (setq l1 (* -1.0 l1))
    
77.     (if        (> l1 0.01)
    
78.       (progn
    
79.         (setq l1 (* (1+ (fix (/ (* 0.25 l1) 50.0))) 50))
    
80.         (if (< l1 700.0)
    
81.           (setq l1 700.0)
    
82.         )
    
83.       )
    
84.     )
    
85.   )
    
86.   (setq l2 (getdist pt2 "\nEnter second length <0.0>: "))
    
87.   (if (= l2 nil)
    
88.     (setq l2 0.0)
    
89.   )
    
90.   (if (< l2 -0.01)
    
91.     (setq l2 (* -1.0 l2))
    
92.     (if        (> l2 0.01)
    
93.       (progn
    
94.         (setq l2 (* (1+ (fix (/ (* 0.25 l2) 50.0))) 50))
    
95.         (if (< l2 700.0)
    
96.           (setq l2 700.0)
    
97.         )
    
98.       )
    
99.     )
    
100.   )
     
101.   (setvar "osmode" 0)
     
102.   (setq an (angle pt1 pt2))
     
103.   (if (> l1 0.01)
     
104.     (setq pt3 (polar pt1 (+ an 3.1415926) l1)
     
105.           s1  (rtos l1 2 0)
     
106.     )
     
107.     (setq pt3 (polar pt1 an (* 0.5 no1))
     
108.           a1  ""
     
109.     )
     
110.   )
     
111.   (if (> l2 0.01)
     
112.     (setq pt4 (polar pt2 an l2)
     
113.           s2  (rtos l2 2 0)
     
114.     )
     
115.     (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 no1))
     
116.           s2  ""
     
117.     )
     
118.   )
     
119.   (setq pt5 (polar pt3 (- an 1.570796) (* 2.5 no1)))
     
120.   (setq pt6 (polar pt4 (- an 1.570796) (* 2.5 no1)))
     
121.   (setq cula (getvar "clayer"))
     
122.   (command "layer" "m" "r0" "")
     
123.   (command "line" pt5 pt3 pt4 pt6 "")
     
124.   (if (> l1 0.01)
     
125.     (progn
     
126.       (setq pt5        (list (* 0.5 (+ (car pt1) (car pt3)))
     
127.                       (* 0.5 (+ (cadr pt1) (cadr pt3)))
     
128.                 )
     
129.       )
     
130.       (if (< an pi)
     
131.         (setq pt5 (polar pt5 (- an (* 0.5 pi)) (* 1.8 no1)))
     
132.         (setq pt5 (polar pt5 (+ an (* 0.5 pi)) (* 1.8 no1)))
     
133.       )
     
134.       (command "layer" "m" "dt" "")
     
135.       (setvar "textstyle" "tz")
     
136.       (command "text" "mc" pt5 (* 2.0 no1) (angtos an 0 4) s1)
     
137.     )
     
138.   )
     
139.   (if (> l2 0.01)
     
140.     (progn
     
141.       (setq pt6        (list (* 0.5 (+ (car pt2) (car pt4)))
     
142.                       (* 0.5 (+ (cadr pt2) (cadr pt4)))
     
143.                 )
     
144.       )
     
145.       (if (< an pi)
     
146.         (setq pt6 (polar pt6 (- an (* 0.5 pi)) (* 1.8 no1)))
     
147.         (setq pt6 (polar pt6 (+ an (* 0.5 pi)) (* 1.8 no1)))
     
148.       )
     
149.       (command "layer" "m" "dt" "")
     
150.       (setvar "textstyle" "tz")
     
151.       (command "text" "mc" pt6 (* 2.0 no1) (angtos an 0 4) s2)
     
152.     )
     
153.   )
     
154.   (setvar "textstyle" te)
     
155.   (setvar "clayer" cula)
     
156.   (setvar "osmode" os)
     
157.   (princ)
     
158. )
     
159. 
     
160. (defun c:dj (/ os pt1 pt2 pt3 pt4 cula an)
     
161.   (if (null no1)
     
162.     (setq no1 100.0)
     
163.   )
     
164.   (setq no1 (UREAL 7 "" "\n比例" no1))
     
165.   (setq os (getvar "osmode"))
     
166.   (setvar "cmdecho" 0)
     
167.   (setvar "osmode" 512)
     
168.   (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))
     
169.   (setvar "osmode" 128)
     
170.   (setq pt2 (getpoint pt1 "\nPick the second point:"))
     
171.   (setvar "osmode" 0)
     
172.   (setq an (angle pt1 pt2))
     
173.   (setq pt3 (polar pt1 an (* 0.5 no1)))
     
174.   (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 no1)))
     
175.   (setq        cula (getvar "clayer")
     
176.         an   (/ (* an 180) 3.1415926)
     
177.   )
     
178.   (command "layer" "s" "r0" "")
     
179.   (command "line" pt3 pt4 "")
     
180.   (command "insert" "g2" pt3 blx blx an)
     
181.   (command "insert" "g2m" pt4 blx blx an)
     
182.   (command "layer" "s" cula "")
     
183.   (setvar "osmode" os)
     
184.   (princ)
     
185. )
     
186. (defun trn (s1 / s0 s2 n0 j)
     
187.   (setq        s0 ""
     
188.         j  1
     
189.   )
     
190.   (while (<= j (strlen s1))
     
191.     (setq s2 (substr s1 j 1))
     
192.     (if        (= s2 "-")
     
193.       (setq s0 (strcat s0 "%%130"))
     
194.       (if (= s2 "+")
     
195.         (setq s0 (strcat s0 "%%131"))
     
196.         (if (= s2 "*")
     
197.           (setq s0 (strcat s0 "x"))
     
198.           (setq s0 (strcat s0 s2))
     
199.         )
     
200.       )
     
201.     )
     
202.     (setq j (1+ j))
     
203.   )
     
204.   (setq s2 s0)
     
205. )
     
206. 
     
207. (defun c:j1 () (j12 1))
     
208. (defun c:j2 () (j12 2))
     
209. 
     
210. (defun j12 (n12        / x y b        a0 a1 a2 cm bi os ln ent entlist na pt pt1 pt2
     
211.             lay)
     
212.   (setq cm (getvar "cmdecho"))
     
213.   (setq bi (getvar "blipmode"))
     
214.   (setq os (getvar "osmode"))
     
215.   (setq ln (getvar "CLAYER"))
     
216.   (setvar "cmdecho" 0)
     
217.   (setvar "blipmode" 0)
     
218.   (setvar "osmode" 0)
     
219.   (if (= n12 1)
     
220.     (setq bna1 "g1"
     
221.           bna2 "g1m"
     
222.     )
     
223.     (setq bna1 "g2"
     
224.           bna2 "g2m"
     
225.     )
     
226.   )
     
227.   (prompt "\nPick a line: ")
     
228.   (setq ent (entsel))
     
229.   (setq entlist (entget (car ent)))
     
230.   (setq na (cdr (assoc 0 entlist)))
     
231.   (setq b (/ no1 100.0))
     
232.   (if (= na "LINE")
     
233.     (progn
     
234.       (setq pt1 (cdr (assoc 10 entlist)))
     
235.       (setq pt2 (cdr (assoc 11 entlist)))
     
236.       (setq lay (cdr (assoc 8 entlist)))
     
237.       (initget 1)
     
238.       (setq pt (getpoint "\nPick a point to direct:"))
     
239.       (setq y (< (distance pt1 pt) (distance pt2 pt)))
     
240.       (setvar "clayer" lay)
     
241.       (setq a1 (angle pt1 pt2)
     
242.             a2 (angle pt2 pt1)
     
243.             a0 (angle pt1 pt)
     
244.       )
     
245.       (setq x (- a1 a0))
     
246.       (if (< x 0.0)
     
247.         (setq x (+ (* 2.0 pi) x))
     
248.       )
     
249.       (if (or (< x pi))
     
250.         (if y
     
251.           (command "insert" bna2 pt1 b b (/ (* 180 a2) pi))
     
252.           (command "insert" bna1 pt2 b b (/ (* 180 a2) pi))
     
253.         )
     
254.         (if y
     
255.           (command "insert" bna1 pt1 b b (/ (* 180 a1) pi))
     
256.           (command "insert" bna2 pt2 b b (/ (* 180 a1) pi))
     
257.         )
     
258.       )
     
259.     )
     
260.     (princ "\nSelect is not a line!")
     
261.   )
     
262.   (setvar "cmdecho" cm)
     
263.   (setvar "blipmode" bi)
     
264.   (setvar "osmode" os)
     
265.   (setvar "CLAYER" ln)
     
266.   (princ)
     
267. )
     
268. 
     
269. (defun c:jt (/ bi os ln ent entlist na pt0 pt1 pt2 pt3)
     
270.   (setq bi (getvar "blipmode"))
     
271.   (setq os (getvar "osmode"))
     
272.   (setq ln (getvar "CLAYER"))
     
273.   (setvar "cmdecho" 0)
     
274.   (setvar "blipmode" 0)
     
275.   (setvar "osmode" 0)
     
276.   (prompt "\nPick a line: ")
     
277.   (if (setq ent (entsel))
     
278.     (progn
     
279.       (setq pt0 (cadr ent))
     
280.       (setq entlist (entget (car ent)))
     
281.       (setq na (cdr (assoc 0 entlist)))
     
282.       (if (= na "LINE")
     
283.         (progn
     
284.           (setq pt1 (cdr (assoc 10 entlist)))
     
285.           (setq pt2 (cdr (assoc 11 entlist)))
     
286.           (setvar "clayer" "D0")
     
287.           (if (> (distance pt1 pt0) (distance pt2 pt0))
     
288.             (setq pt3 pt1
     
289.                   pt1 pt2
     
290.                   pt2 pt3
     
291.             )
     
292.           )
     
293.           (setq pt3 (polar pt1 (angle pt1 pt2) (* no1 3.5)))
     
294.           (command "pline" pt1 "w" "0" (* 0.8 no1) pt3 "")
     
295.         )
     
296.         (princ "\nSelect is not a line!")
     
297.       )
     
298.     )
     
299.     (princ "\nSelect is empty!")
     
300.   )
     
301.   (setvar "blipmode" bi)
     
302.   (setvar "osmode" os)
     
303.   (setvar "CLAYER" ln)
     
304.   (princ)
     
305. )
     
306. 
     
307. (defun c:g (/ la os tes ss s pt0 pt1 pt2 pt3 pt4 x1 y1 x2 y2 ang p r h)
     
308.   (setvar "cmdecho" 0)
     
309.   (setq la (getvar "clayer"))
     
310.   (setq        os (getvar "osmode")
     
311.         r  (* 2.5 no1)
     
312.         h  (* 2.25 no1)
     
313.   )
     
314.   (setq tes (getvar "textstyle"))
     
315.   (setvar "osmode" 0)
     
316.   (if (= gna nil)
     
317.     (setq gna 1)
     
318.   )
     
319.   (setq s (entsel "\nPick the GJ_line:"))
     
320.   (if s
     
321.     (progn
     
322.       (setq pt0        (cadr s)
     
323.             s        (car s)
     
324.       )
     
325.       (redraw s 3)
     
326.       (setq ss (entget s))
     
327.       (if (= (cdr (assoc 0 ss)) "LINE")
     
328.         (progn
     
329.           (setq pt0 (osnap pt0 "Nearest"))
     
330.           (setq pt1 (cdr (assoc 10 ss)))
     
331.           (setq pt2 (cdr (assoc 11 ss)))
     
332.           (setq        x1 (car pt1)
     
333.                 y1 (cadr pt1)
     
334.                 x2 (car pt2)
     
335.                 y2 (cadr pt2)
     
336.           )
     
337.           (if (not (or (and (< (abs (- x1 x2)) 0.00001) (< y1 y2))
     
338.                        (< x1 x2)
     
339.                    )
     
340.               )
     
341.             (setq p   pt2
     
342.                   pt2 pt1
     
343.                   pt1 p
     
344.             )
     
345.           )
     
346.           (setq ang (angle pt1 pt2))
     
347.           (initget 1)
     
348.           (setq pt3 (getpoint pt0 "\nPick the directive point:"))
     
349.           (setq p (- (angle pt1 pt3) ang))
     
350.           (if (< p 0.0)
     
351.             (setq p (+ (* 2.0 pi) p))
     
352.           )
     
353.           (if (< p pi)
     
354.             (setq pt4 (polar pt0 (+ ang (* 0.5 pi)) r))
     
355.             (setq pt4 (polar pt0 (- ang (* 0.5 pi)) r))
     
356.           )
     
357.           (setq pt0 (getint (strcat "\nG_name: <" (itoa gna) "> ")))
     
358.           (if (/= pt0 nil)
     
359.             (setq gna pt0)
     
360.           )
     
361.           (setvar "textstyle" "tz")
     
362.           (command "layer" "m" "dt" "")
     
363.           (command "circle" pt4 r)
     
364.           (command "text" "m" pt4 h (/ (* 180.0 ang) pi) (itoa gna))
     
365.         )
     
366.         (princ "\nPlease select a GJ_line!")
     
367.       )
     
368.       (redraw s 4)
     
369.     )
     
370.     (princ "\nPlease select a entity!")
     
371.   )
     
372.   (setvar "textstyle" tes)
     
373.   (setvar "osmode" os)
     
374.   (setvar "clayer" la)
     
375.   (princ)
     
376. )
     
377. 
     
378. (defun c:xx (/ os la l1 es pt1 pt2 pt3 pt4 pt an ss s n i)
     
379.   (setq os (getvar "osmode"))
     
380.   (setvar "cmdecho" 0)
     
381.   (setq la (getvar "clayer"))
     
382.   (setvar "osmode" 0)
     
383.   (setq l1 (entsel "Pick first line:"))
     
384.   (if l1
     
385.     (if        (/= (cdr (assoc 0 (entget (car l1)))) "LINE")
     
386.       (setq l1 nil)
     
387.     )
     
388.   )
     
389.   (if l1
     
390.     (progn
     
391.       (setq l1 (car l1)
     
392.             es (entget l1)
     
393.       )
     
394.       (redraw l1 3)
     
395.       (setq pt1 (cdr (assoc 10 es)))
     
396.       (setq pt2 (cdr (assoc 11 es)))
     
397.       (setq an (angle pt1 pt2))
     
398.       (setq ss (ssget))
     
399.       (setq n (sslength ss)
     
400.             i 0
     
401.       )
     
402.       (setvar "clayer" "D0")
     
403.       (repeat n
     
404.         (setq s        (ssname ss i)
     
405.               i        (1+ i)
     
406.         )
     
407.         (setq es (entget s))
     
408.         (if (= (cdr (assoc 0 es)) "LINE")
     
409.           (progn
     
410.             (setq pt3 (cdr (assoc 10 es)))
     
411.             (setq pt4 (cdr (assoc 11 es)))
     
412.             (setq pt (inters pt1 pt2 pt3 pt4))
     
413.             (if        pt
     
414.               (command "insert"
     
415.                        "G3"
     
416.                        pt
     
417.                        (/ no1 100)
     
418.                        ""
     
419.                        (/ (* an 180) pi)
     
420.               )
     
421.             )
     
422.           )
     
423.         )
     
424.       )
     
425.       (redraw l1 4)
     
426.     )
     
427.   )
     
428.   (setvar "clayer" la)
     
429.   (setvar "osmode" os)
     
430.   (princ)
     
431. )
     
432. 
     
433. (defun c:dt (/ pt1 pt2 an osm str pe)
     
434.   (setvar "cmdecho" 0)
     
435.   (setvar "orthomode" 1)
     
436.   (setq osm (getvar "osmode"))
     
437.   (setvar "osmode" 0)
     
438.   (if (= dis nil)
     
439.     (setq dis 200.0)
     
440.   )
     
441.   (setq pe t)
     
442.   (while (/= pe nil)
     
443.     (setq str (strcat "\nDistance{ " (rtos dis 2 0) " }//First point:"))
     
444.     (initget "Distance Exit")
     
445.     (setq pt0 (getpoint str))
     
446.     (cond
     
447.       ((= pt0 nil) (setq pe nil))
     
448.       ((= pt0 "Exit") (setq pe nil))
     
449.       ((= pt0 "Distance") (setq dis (getdist "\nDistance:")))
     
450.       (t
     
451.        (progn
     
452.          (setq pt1 (getcorner pt0 "\nSecond point:"))
     
453.          (command "stretch" "c" pt0 pt1 "")
     
454.          (setq pt2 (getpoint pt1 "\nDirecte point:"))
     
455.          (setq an (angtos (angle pt1 pt2) 0 2))
     
456.          (command pt1 (strcat "@" (rtos dis 2 1) "<" an))
     
457.        )
     
458.       )
     
459.     )
     
460.   )
     
461.   (setvar "osmode" osm)
     
462.   (princ)
     
463. )
     
464. (defun ureal (bit kwd msg def / inp)
     
465.   (if def
     
466.     (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
     
467.           bit (* 2 (fix (/ bit 2)))
     
468.     )
     
469.     (setq msg (strcat "\n" msg ": "))
     
470.   )
     
471.   (initget bit kwd)
     
472.   (setq inp (getreal msg))
     
473.   (if inp
     
474.     inp
     
475.     def
     
476.   )
     
477. )
     
478. (princ)[/FONT]

[FONT=courier new];;钢筋、负筋、底筋<br /> (defun c:gj (/ a1 ss si i ssl pt pt1 pt2 p1 p2 ts d cla os)<br />   (if (null no1)<br />     (setq no1 100.0)<br />   )<br />   (setq        no1 (UREAL 7 "" "\n比例" no1)<br />         d   (getvar "BLIPMODE")<br />         cla (getvar "clayer")<br />         os  (getvar "osmode")<br />         s   (* 0.8 no1)<br />   )<br />   (setvar "CMDECHO" 0)<br />   (setvar "BLIPMODE" 0)<br />   (setvar "osmode" 0)<br />   (princ "\nSelect an line to get GJ: ")<br />   (setq ss (ssget))<br />   (if ss<br />     (progn<br />       (setq pt (getpoint "\nDirection Point:")<br />             i  0<br />       )<br />       (repeat (sslength ss)<br />         (setq si  (ssname ss i)<br />               i          (1+ i)<br />               ssl (entget si)<br />         )<br />         (if (= (cdr (assoc 0 ssl)) "LINE")<br />           (progn<br />             (setq pt1 (cdr (assoc 10 ssl))<br />                   pt2 (cdr (assoc 11 ssl))<br />                   a1  (angle pt1 pt2)<br />                   p1  (polar pt1 (+ a1 (* 0.5 pi)) ts)<br />                   p2  (polar pt1 (- a1 (* 0.5 pi)) ts)<br />             )<br />             (if        (> (distance p1 pt) (distance p2 pt))<br />               (setq p1 p2)<br />             )<br />             (setq p2 (polar pt2 (angle pt1 p1) ts)<br />                   p1 (polar p1 a1 ts)<br />                   p2 (polar p2 (+ a1 pi) ts)<br />             )<br />             (command "layer" "m" "r0" "c" "1" "" "")<br />             (command "line" p1 p2 "")<br />           )<br />         )<br />       )<br />     )<br />     (princ "\nSelect is Empty!")<br />   )<br />   (setvar "BLIPMODE" d)<br />   (setvar "clayer" cla)<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> <br /> (defun c:fj (/ os pt1 pt2 pt3 pt4 pt5 pt6 l1 l2 cula an s1 s2)<br />   (if (null no1)<br />     (setq no1 100.0)<br />   )<br />   (setq        no1 (UREAL 7 "" "\n比例" no1)<br />         os  (getvar "osmode")<br />   )<br />   (setvar "cmdecho" 0)<br />   (setq te (getvar "textstyle"))<br />   (setvar "osmode" 512)<br />   (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))<br />   (setvar "osmode" 128)<br />   (setq pt2 (getpoint pt1 "\nPick the second point:"))<br />   (setvar "osmode" 128)<br />   (setq l1 (getdist pt1 "\nEnter first length <0.0>: "))<br />   (if (= l1 nil)<br />     (setq l1 0.0)<br />   )<br />   (if (< l1 -0.01)<br />     (setq l1 (* -1.0 l1))<br />     (if        (> l1 0.01)<br />       (progn<br />         (setq l1 (* (1+ (fix (/ (* 0.25 l1) 50.0))) 50))<br />         (if (< l1 700.0)<br />           (setq l1 700.0)<br />         )<br />       )<br />     )<br />   )<br />   (setq l2 (getdist pt2 "\nEnter second length <0.0>: "))<br />   (if (= l2 nil)<br />     (setq l2 0.0)<br />   )<br />   (if (< l2 -0.01)<br />     (setq l2 (* -1.0 l2))<br />     (if        (> l2 0.01)<br />       (progn<br />         (setq l2 (* (1+ (fix (/ (* 0.25 l2) 50.0))) 50))<br />         (if (< l2 700.0)<br />           (setq l2 700.0)<br />         )<br />       )<br />     )<br />   )<br />   (setvar "osmode" 0)<br />   (setq an (angle pt1 pt2))<br />   (if (> l1 0.01)<br />     (setq pt3 (polar pt1 (+ an 3.1415926) l1)<br />           s1  (rtos l1 2 0)<br />     )<br />     (setq pt3 (polar pt1 an (* 0.5 no1))<br />           a1  ""<br />     )<br />   )<br />   (if (> l2 0.01)<br />     (setq pt4 (polar pt2 an l2)<br />           s2  (rtos l2 2 0)<br />     )<br />     (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 no1))<br />           s2  ""<br />     )<br />   )<br />   (setq pt5 (polar pt3 (- an 1.570796) (* 2.5 no1)))<br />   (setq pt6 (polar pt4 (- an 1.570796) (* 2.5 no1)))<br />   (setq cula (getvar "clayer"))<br />   (command "layer" "m" "r0" "")<br />   (command "line" pt5 pt3 pt4 pt6 "")<br />   (if (> l1 0.01)<br />     (progn<br />       (setq pt5        (list (* 0.5 (+ (car pt1) (car pt3)))<br />                       (* 0.5 (+ (cadr pt1) (cadr pt3)))<br />                 )<br />       )<br />       (if (< an pi)<br />         (setq pt5 (polar pt5 (- an (* 0.5 pi)) (* 1.8 no1)))<br />         (setq pt5 (polar pt5 (+ an (* 0.5 pi)) (* 1.8 no1)))<br />       )<br />       (command "layer" "m" "dt" "")<br />       (setvar "textstyle" "tz")<br />       (command "text" "mc" pt5 (* 2.0 no1) (angtos an 0 4) s1)<br />     )<br />   )<br />   (if (> l2 0.01)<br />     (progn<br />       (setq pt6        (list (* 0.5 (+ (car pt2) (car pt4)))<br />                       (* 0.5 (+ (cadr pt2) (cadr pt4)))<br />                 )<br />       )<br />       (if (< an pi)<br />         (setq pt6 (polar pt6 (- an (* 0.5 pi)) (* 1.8 no1)))<br />         (setq pt6 (polar pt6 (+ an (* 0.5 pi)) (* 1.8 no1)))<br />       )<br />       (command "layer" "m" "dt" "")<br />       (setvar "textstyle" "tz")<br />       (command "text" "mc" pt6 (* 2.0 no1) (angtos an 0 4) s2)<br />     )<br />   )<br />   (setvar "textstyle" te)<br />   (setvar "clayer" cula)<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> <br /> (defun c:dj (/ os pt1 pt2 pt3 pt4 cula an)<br />   (if (null no1)<br />     (setq no1 100.0)<br />   )<br />   (setq no1 (UREAL 7 "" "\n比例" no1))<br />   (setq os (getvar "osmode"))<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 512)<br />   (setq pt1 (osnap (getpoint "\nPick the first point:") "near"))<br />   (setvar "osmode" 128)<br />   (setq pt2 (getpoint pt1 "\nPick the second point:"))<br />   (setvar "osmode" 0)<br />   (setq an (angle pt1 pt2))<br />   (setq pt3 (polar pt1 an (* 0.5 no1)))<br />   (setq pt4 (polar pt2 (+ an 3.1415926) (* 0.5 no1)))<br />   (setq        cula (getvar "clayer")<br />         an   (/ (* an 180) 3.1415926)<br />   )<br />   (command "layer" "s" "r0" "")<br />   (command "line" pt3 pt4 "")<br />   (command "insert" "g2" pt3 blx blx an)<br />   (command "insert" "g2m" pt4 blx blx an)<br />   (command "layer" "s" cula "")<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> (defun trn (s1 / s0 s2 n0 j)<br />   (setq        s0 ""<br />         j  1<br />   )<br />   (while (<= j (strlen s1))<br />     (setq s2 (substr s1 j 1))<br />     (if        (= s2 "-")<br />       (setq s0 (strcat s0 "%%130"))<br />       (if (= s2 "+")<br />         (setq s0 (strcat s0 "%%131"))<br />         (if (= s2 "*")<br />           (setq s0 (strcat s0 "x"))<br />           (setq s0 (strcat s0 s2))<br />         )<br />       )<br />     )<br />     (setq j (1+ j))<br />   )<br />   (setq s2 s0)<br /> )<br /> <br /> (defun c:j1 () (j12 1))<br /> (defun c:j2 () (j12 2))<br /> <br /> (defun j12 (n12        / x y b        a0 a1 a2 cm bi os ln ent entlist na pt pt1 pt2<br />             lay)<br />   (setq cm (getvar "cmdecho"))<br />   (setq bi (getvar "blipmode"))<br />   (setq os (getvar "osmode"))<br />   (setq ln (getvar "CLAYER"))<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setvar "osmode" 0)<br />   (if (= n12 1)<br />     (setq bna1 "g1"<br />           bna2 "g1m"<br />     )<br />     (setq bna1 "g2"<br />           bna2 "g2m"<br />     )<br />   )<br />   (prompt "\nPick a line: ")<br />   (setq ent (entsel))<br />   (setq entlist (entget (car ent)))<br />   (setq na (cdr (assoc 0 entlist)))<br />   (setq b (/ no1 100.0))<br />   (if (= na "LINE")<br />     (progn<br />       (setq pt1 (cdr (assoc 10 entlist)))<br />       (setq pt2 (cdr (assoc 11 entlist)))<br />       (setq lay (cdr (assoc 8 entlist)))<br />       (initget 1)<br />       (setq pt (getpoint "\nPick a point to direct:"))<br />       (setq y (< (distance pt1 pt) (distance pt2 pt)))<br />       (setvar "clayer" lay)<br />       (setq a1 (angle pt1 pt2)<br />             a2 (angle pt2 pt1)<br />             a0 (angle pt1 pt)<br />       )<br />       (setq x (- a1 a0))<br />       (if (< x 0.0)<br />         (setq x (+ (* 2.0 pi) x))<br />       )<br />       (if (or (< x pi))<br />         (if y<br />           (command "insert" bna2 pt1 b b (/ (* 180 a2) pi))<br />           (command "insert" bna1 pt2 b b (/ (* 180 a2) pi))<br />         )<br />         (if y<br />           (command "insert" bna1 pt1 b b (/ (* 180 a1) pi))<br />           (command "insert" bna2 pt2 b b (/ (* 180 a1) pi))<br />         )<br />       )<br />     )<br />     (princ "\nSelect is not a line!")<br />   )<br />   (setvar "cmdecho" cm)<br />   (setvar "blipmode" bi)<br />   (setvar "osmode" os)<br />   (setvar "CLAYER" ln)<br />   (princ)<br /> )<br /> <br /> (defun c:jt (/ bi os ln ent entlist na pt0 pt1 pt2 pt3)<br />   (setq bi (getvar "blipmode"))<br />   (setq os (getvar "osmode"))<br />   (setq ln (getvar "CLAYER"))<br />   (setvar "cmdecho" 0)<br />   (setvar "blipmode" 0)<br />   (setvar "osmode" 0)<br />   (prompt "\nPick a line: ")<br />   (if (setq ent (entsel))<br />     (progn<br />       (setq pt0 (cadr ent))<br />       (setq entlist (entget (car ent)))<br />       (setq na (cdr (assoc 0 entlist)))<br />       (if (= na "LINE")<br />         (progn<br />           (setq pt1 (cdr (assoc 10 entlist)))<br />           (setq pt2 (cdr (assoc 11 entlist)))<br />           (setvar "clayer" "D0")<br />           (if (> (distance pt1 pt0) (distance pt2 pt0))<br />             (setq pt3 pt1<br />                   pt1 pt2<br />                   pt2 pt3<br />             )<br />           )<br />           (setq pt3 (polar pt1 (angle pt1 pt2) (* no1 3.5)))<br />           (command "pline" pt1 "w" "0" (* 0.8 no1) pt3 "")<br />         )<br />         (princ "\nSelect is not a line!")<br />       )<br />     )<br />     (princ "\nSelect is empty!")<br />   )<br />   (setvar "blipmode" bi)<br />   (setvar "osmode" os)<br />   (setvar "CLAYER" ln)<br />   (princ)<br /> )<br /> <br /> (defun c:g (/ la os tes ss s pt0 pt1 pt2 pt3 pt4 x1 y1 x2 y2 ang p r h)<br />   (setvar "cmdecho" 0)<br />   (setq la (getvar "clayer"))<br />   (setq        os (getvar "osmode")<br />         r  (* 2.5 no1)<br />         h  (* 2.25 no1)<br />   )<br />   (setq tes (getvar "textstyle"))<br />   (setvar "osmode" 0)<br />   (if (= gna nil)<br />     (setq gna 1)<br />   )<br />   (setq s (entsel "\nPick the GJ_line:"))<br />   (if s<br />     (progn<br />       (setq pt0        (cadr s)<br />             s        (car s)<br />       )<br />       (redraw s 3)<br />       (setq ss (entget s))<br />       (if (= (cdr (assoc 0 ss)) "LINE")<br />         (progn<br />           (setq pt0 (osnap pt0 "Nearest"))<br />           (setq pt1 (cdr (assoc 10 ss)))<br />           (setq pt2 (cdr (assoc 11 ss)))<br />           (setq        x1 (car pt1)<br />                 y1 (cadr pt1)<br />                 x2 (car pt2)<br />                 y2 (cadr pt2)<br />           )<br />           (if (not (or (and (< (abs (- x1 x2)) 0.00001) (< y1 y2))<br />                        (< x1 x2)<br />                    )<br />               )<br />             (setq p   pt2<br />                   pt2 pt1<br />                   pt1 p<br />             )<br />           )<br />           (setq ang (angle pt1 pt2))<br />           (initget 1)<br />           (setq pt3 (getpoint pt0 "\nPick the directive point:"))<br />           (setq p (- (angle pt1 pt3) ang))<br />           (if (< p 0.0)<br />             (setq p (+ (* 2.0 pi) p))<br />           )<br />           (if (< p pi)<br />             (setq pt4 (polar pt0 (+ ang (* 0.5 pi)) r))<br />             (setq pt4 (polar pt0 (- ang (* 0.5 pi)) r))<br />           )<br />           (setq pt0 (getint (strcat "\nG_name: <" (itoa gna) "> ")))<br />           (if (/= pt0 nil)<br />             (setq gna pt0)<br />           )<br />           (setvar "textstyle" "tz")<br />           (command "layer" "m" "dt" "")<br />           (command "circle" pt4 r)<br />           (command "text" "m" pt4 h (/ (* 180.0 ang) pi) (itoa gna))<br />         )<br />         (princ "\nPlease select a GJ_line!")<br />       )<br />       (redraw s 4)<br />     )<br />     (princ "\nPlease select a entity!")<br />   )<br />   (setvar "textstyle" tes)<br />   (setvar "osmode" os)<br />   (setvar "clayer" la)<br />   (princ)<br /> )<br /> <br /> (defun c:xx (/ os la l1 es pt1 pt2 pt3 pt4 pt an ss s n i)<br />   (setq os (getvar "osmode"))<br />   (setvar "cmdecho" 0)<br />   (setq la (getvar "clayer"))<br />   (setvar "osmode" 0)<br />   (setq l1 (entsel "Pick first line:"))<br />   (if l1<br />     (if        (/= (cdr (assoc 0 (entget (car l1)))) "LINE")<br />       (setq l1 nil)<br />     )<br />   )<br />   (if l1<br />     (progn<br />       (setq l1 (car l1)<br />             es (entget l1)<br />       )<br />       (redraw l1 3)<br />       (setq pt1 (cdr (assoc 10 es)))<br />       (setq pt2 (cdr (assoc 11 es)))<br />       (setq an (angle pt1 pt2))<br />       (setq ss (ssget))<br />       (setq n (sslength ss)<br />             i 0<br />       )<br />       (setvar "clayer" "D0")<br />       (repeat n<br />         (setq s        (ssname ss i)<br />               i        (1+ i)<br />         )<br />         (setq es (entget s))<br />         (if (= (cdr (assoc 0 es)) "LINE")<br />           (progn<br />             (setq pt3 (cdr (assoc 10 es)))<br />             (setq pt4 (cdr (assoc 11 es)))<br />             (setq pt (inters pt1 pt2 pt3 pt4))<br />             (if        pt<br />               (command "insert"<br />                        "G3"<br />                        pt<br />                        (/ no1 100)<br />                        ""<br />                        (/ (* an 180) pi)<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (redraw l1 4)<br />     )<br />   )<br />   (setvar "clayer" la)<br />   (setvar "osmode" os)<br />   (princ)<br /> )<br /> <br /> (defun c:dt (/ pt1 pt2 an osm str pe)<br />   (setvar "cmdecho" 0)<br />   (setvar "orthomode" 1)<br />   (setq osm (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (if (= dis nil)<br />     (setq dis 200.0)<br />   )<br />   (setq pe t)<br />   (while (/= pe nil)<br />     (setq str (strcat "\nDistance{ " (rtos dis 2 0) " }//First point:"))<br />     (initget "Distance Exit")<br />     (setq pt0 (getpoint str))<br />     (cond<br />       ((= pt0 nil) (setq pe nil))<br />       ((= pt0 "Exit") (setq pe nil))<br />       ((= pt0 "Distance") (setq dis (getdist "\nDistance:")))<br />       (t<br />        (progn<br />          (setq pt1 (getcorner pt0 "\nSecond point:"))<br />          (command "stretch" "c" pt0 pt1 "")<br />          (setq pt2 (getpoint pt1 "\nDirecte point:"))<br />          (setq an (angtos (angle pt1 pt2) 0 2))<br />          (command pt1 (strcat "@" (rtos dis 2 1) "<" an))<br />        )<br />       )<br />     )<br />   )<br />   (setvar "osmode" osm)<br />   (princ)<br /> )<br /> (defun ureal (bit kwd msg def / inp)<br />   (if def<br />     (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")<br />           bit (* 2 (fix (/ bit 2)))<br />     )<br />     (setq msg (strcat "\n" msg ": "))<br />   )<br />   (initget bit kwd)<br />   (setq inp (getreal msg))<br />   (if inp<br />     inp<br />     def<br />   )<br /> )<br /> (princ)[/FONT]

HLB_Konan

这里太谢谢 xyp1964版主了   不过还有问题没有解决好 就是底筋时出现 Pick the second point:0.000000 未知命令“2”。按 F1 查看帮助。未知命令“G2M”。按 F1 查看帮助。 0.000000
; 错误: 函数被取消 而且那个弯起勾没有弄好  钢筋也就是gj这个命令也没有弄好 出现Direction Point:; 错误: 参数类型错误: numberp: nil 希望版主能再次帮忙 再次感谢了