八方求助啊!!!

blue123

冰天雪地裸体跪求啊,祥见question.dwg文件

blue123

我是一个菜鸟,CAD倒用了好几年,不过Autolisp两个礼拜前才开始学,希望各位高手援助.

 不管怎样也要顶顶顶那么几下啊!!!!

june_24

乱码。

blue123

(defun c:yy()
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq lang (getdist "请输入延长值:"))
  (setq lin (entsel "\n请选择要延长的线:"))
  (setq ss (entget (car lin))
        lin_p1 (assoc 10 ss)
        lin_p2 (assoc 11 ss)
        p1 (cdr lin_p1)
        P2 (cdr lin_p2)
        pme (cadr lin))
        pe (osnap "end")
        p1x (car p1)
        P1y (cadr p1)
        pex (car pe)
        pey (cadr pe))
  (if (= px1 pex)
        (if (= p1y pey) (progn (setq ang (angle p2 p1))
                               (setq p3 (polar pe ang leng))
                               (seqt lin_p1_n (cons 10 p3))
                                (setq ss (lubst lin_p1_n lin_p1 ss)))
                       (progn (setq ang (angle p1 p2)) (setq p3 (polar pe ang leng))
                            (setq lin_p2_n (cons 11 p3))
                            (setq ss (subst lin_p2_n lin_p2 ss)))
                       )
                     (progn (setq ang (angle p1 p2)) (setq p3 (polar pe ang leng))
                            (setq lin_p2_n (cons 11 p3))
                            (setq ss (subst lin_p2_n lin_p2 ss))
                     )
         )
(entmod ss)
)
(command "undo" "e")
(setvar "cmdecho" 1)
)
(princ)
)

meflying

冻死你!

meflying

1.四个端点的距离是哪个距离?
其余程序如下:

2. (defun c:disCir( / ss ent ents lay i r rs item zin)
3.   (setq zin (getvar "dimzin"))
4.   (setvar "dimzin" 0)
5.   (setvar "cmdecho" 0)
6.   (command "_.purge" "la" "*" "n")
7.   (setq ss (ssget "x" '((0 . "CIRCLE"))))
8.   (setq i 0)
9.   (setq lay 0)
10.   (repeat (sslength ss)
11.     (setq ent (ssname ss i))
12.     (setq ents (entget ent))
13.     (setq r (cdr (assoc 40 ents)))
14.     (if (assoc r rs)
15.       (progn
16. (setq item (reverse (assoc r rs)))
17. (setq item (reverse (cons (1+ (car item)) (cdr item))))
18. (setq rs (subst item (assoc r rs) rs))
19.       )
20.       (progn
21. (setq rs (append rs (list (list r (strcat "mylayer_" (rtos lay 2 0)) 1))))
22. (command "_.layer" "m" (strcat "mylayer_" (rtos lay 2 0)) "")
23. (setq lay (1+ lay))
24.   
25.       )
26.     )   
27.     (command "_.change" ent "" "p" "la" (cadr (assoc r rs)) "")   
28.     (setq i (1+ i))
29.   )
30.   (princ "\n图层\t\t直径\t\t孔数")
31.   (princ "\n------------------------------")
32.   (mapcar '(lambda(e) (princ (strcat "\n" (rtos (car e) 2 2) "\t" (cadr e) "\t" (rtos (last e) 2 0)))) rs)
33.   (setvar "dimzin" zin)
34.   (textscr)
35.   (princ)
36. )
37. (defun c:sline( / ent slong pt ents pt1 pt2 dis)
38.   (setq ent (entsel))
39.   (setq slong (getreal "\n输入延长长度:"))
40.   (setq pt (cadr ent)
41. ent (car ent))
42.   (setq ents (entget ent))
43.   (setq pt1 (cdr (assoc 10 ents))
44. pt2 (cdr (assoc 11 ents)))
45.   (setq dis (distance pt1 pt2))
46.   (if (< (distance pt pt1) dis)
47.     (command "_.scale" ent "" pt2 (/ (+ dis slong) dis))
48.     (command "_.scale" ent "" pt1 (/ (+ dis slong) dis))
49.   )
50.   (princ)
51. )

(defun c:disCir( / ss ent ents lay i r rs item zin)   (setq zin (getvar "dimzin"))   (setvar "dimzin" 0)   (setvar "cmdecho" 0)   (command "_.purge" "la" "*" "n")   (setq ss (ssget "x" '((0 . "CIRCLE"))))   (setq i 0)   (setq lay 0)   (repeat (sslength ss)     (setq ent (ssname ss i))     (setq ents (entget ent))     (setq r (cdr (assoc 40 ents)))     (if (assoc r rs)       (progn (setq item (reverse (assoc r rs))) (setq item (reverse (cons (1+ (car item)) (cdr item)))) (setq rs (subst item (assoc r rs) rs))       )       (progn (setq rs (append rs (list (list r (strcat "mylayer_" (rtos lay 2 0)) 1)))) (command "_.layer" "m" (strcat "mylayer_" (rtos lay 2 0)) "") (setq lay (1+ lay))          )     )        (command "_.change" ent "" "p" "la" (cadr (assoc r rs)) "")        (setq i (1+ i))   )   (princ "\n图层\t\t直径\t\t孔数")   (princ "\n------------------------------")   (mapcar '(lambda(e) (princ (strcat "\n" (rtos (car e) 2 2) "\t" (cadr e) "\t" (rtos (last e) 2 0)))) rs)   (setvar "dimzin" zin)   (textscr)   (princ) ) (defun c:sline( / ent slong pt ents pt1 pt2 dis)   (setq ent (entsel))   (setq slong (getreal "\n输入延长长度:"))   (setq pt (cadr ent) ent (car ent))   (setq ents (entget ent))   (setq pt1 (cdr (assoc 10 ents)) pt2 (cdr (assoc 11 ents)))   (setq dis (distance pt1 pt2))   (if (< (distance pt pt1) dis)     (command "_.scale" ent "" pt2 (/ (+ dis slong) dis))     (command "_.scale" ent "" pt1 (/ (+ dis slong) dis))   )   (princ) )

ZZXXQQ

延长线

(DEFUN CL ()

(COMMAND "LENGTHEN" "DE" PAUSE)

)

yedajiang

你可真够贱啊！难得！难得！