仿别人的一个程序----源码！---更新第二个程序，在18楼

朽木大师

做个记号，以备忘

sicky111

xingyun300 发表于 2012-8-7 14:14
更新第二个我用的程序，只是和别人的思路不一样！、希望大家指点一下！！！！！互相学习一下！！！！

(d ...

这不就是圆画中心线么？

AMTONNY

想法不错了，省了不少时间了嘀

ucuc2003

直线变矩形我也改了一点
;;;;直线变矩形========================
(defun c:tt()
(setvar "cmdecho" 0)
(setq old_os (getvar "osmode"))
(setvar "osmode" 0)
(prompt "直线变矩形")
  (if (= zx_jx nil) (setq zx_jx 100))
  (princ (strcat "\n请输入矩形宽度 <" (rtos zx_jx 2 3) ">: "))
  (setq ww (getdist))
  (if (= ww nil) (setq w zx_jx))
  (setq zx_jx ww)
(setq ss (ssget '((0 . "LINE"))))
(setq nn 0)
(repeat (sslength ss)
      (setq en (ssname ss nn))
   (setq endata (entget en))
   (progn (setq pts (assoc 10 endata))
          (setq pt1 (cdr pts))
      (setq pte (assoc 11 endata))
      (setq pt2 (cdr pte))
      (setq ll (distance pt1 pt2))
      (setq ang (angle pt1 pt2))
      (setq pta (polar pt1 (+ ang (/ pi 2)) (/ ww 2)))
      (setq ptb (polar pta (+ ang (* pi 1.5)) ww))
      (setq ptc (polar ptb ang ll))
      (setq ptd (polar pta ang ll))
      (command "pline" pta ptb ptc ptd "c")
      (setq nn (1+ nn))
      )
      )
(setvar "osmode" old_os)
(setvar "cmdecho" 1)
(princ)
)

ucuc2003

2. ;这是一个版主的大作，我做了点改动。程序和你的有点相似。是哪位版主的我忘记了，感谢这位版主！
   
3. (defun c:zhj (/ w p1 p2 ang )
   
4.   (setvar "cmdecho" 0)
   
5.   (setvar "osmode" 1023)
   
6.   (princ "绘矩形")  
   
7.   (if *H_JX*
   
8.       (setq H_JX (getdist (strcat "\n输入宽度<" (rtos *H_JX* 2 4) ">:")))
   
9.       (setq H_JX (getdist "\n输入宽度:"))
   
10.   )
    
11.   (if (not H_JX) (setq H_JX *H_JX*) (setq *H_JX* H_JX))
    
12.   (setq w H_JX)
    
13. 
    
14.   (princ "\n输入")
    
15.   (while (and
    
16.            (setq p1 (getpoint "第一点："))
    
17.            (setq p2  (getpoint p1 "\n第二点："))
    
18.            )
    
19.     (setq ang (angle p1 p2) l (distance p1 p2))
    
20.     (entmake
    
21.       (list
    
22.         '(0 . "LWPOLYLINE")
    
23.         '(100 . "AcDbEntity")
    
24.         '(100 . "AcDbPolyline")
    
25.         '(90 . 4)
    
26.         '(70 . 1)
    
27.         '(43 . 0.0)
    
28.         '(38 . 0.0)
    
29.         '(39 . 0.0)
    
30.         (cons 10 (trans (setq p(polar p1 (+ ang (* 0.5 pi)) (* 0.5 w))) 1 0))
    
31.         (cons 10 (trans (setq p (polar p ang l)) 1 0))
    
32.         (cons 10 (trans (setq p (polar p (- ang (* 0.5 pi)) w)) 1 0))
    
33.         (cons 10 (trans (setq p (polar p (+ pi ang) l)) 1 0))
    
34.         )
    
35.       )
    
36.     (princ "\n**继续输入")
    
37.     )
    
38.   (princ)
    
39. );defun

;这是一个版主的大作，我做了点改动。程序和你的有点相似。是哪位版主的我忘记了，感谢这位版主！<br /> (defun c:zhj (/ w p1 p2 ang )<br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 1023)<br />   (princ "绘矩形")  <br />   (if *H_JX*<br />       (setq H_JX (getdist (strcat "\n输入宽度<" (rtos *H_JX* 2 4) ">:")))<br />       (setq H_JX (getdist "\n输入宽度:"))<br />   )<br />   (if (not H_JX) (setq H_JX *H_JX*) (setq *H_JX* H_JX))<br />   (setq w H_JX)<br /> <br />   (princ "\n输入")<br />   (while (and<br />            (setq p1 (getpoint "第一点："))<br />            (setq p2  (getpoint p1 "\n第二点："))<br />            )<br />     (setq ang (angle p1 p2) l (distance p1 p2))<br />     (entmake<br />       (list<br />         '(0 . "LWPOLYLINE")<br />         '(100 . "AcDbEntity")<br />         '(100 . "AcDbPolyline")<br />         '(90 . 4) <br />         '(70 . 1)<br />         '(43 . 0.0)<br />         '(38 . 0.0)<br />         '(39 . 0.0)<br />         (cons 10 (trans (setq p(polar p1 (+ ang (* 0.5 pi)) (* 0.5 w))) 1 0))<br />         (cons 10 (trans (setq p (polar p ang l)) 1 0))<br />         (cons 10 (trans (setq p (polar p (- ang (* 0.5 pi)) w)) 1 0))<br />         (cons 10 (trans (setq p (polar p (+ pi ang) l)) 1 0))<br />         )<br />       )<br />     (princ "\n**继续输入")<br />     )<br />   (princ)<br /> );defun

香田里浪人

ucuc2003 发表于 2013-5-25 10:08

;直线变矩形我也改了一点
(defun c:hjx(/ w p1 p2 ang )
(command "layer" "M" "矩形" "C" "4" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
  (setvar "cmdecho" 0)
  (setvar "osmode" 1023)
  (princ "绘矩形")  
  (if *H_JX*
      (setq H_JX (getdist (strcat "\n输入宽度<" (rtos *H_JX* 2 4) ">:")))
      (setq H_JX (getdist "\n输入宽度:"))
  )
  (if (not H_JX) (setq H_JX *H_JX*) (setq *H_JX* H_JX))
  (setq w H_JX)
  (princ "\n输入")
  (while (and
           (setq p1 (getpoint "第一点："))
           (setq p2  (getpoint p1 "\n第二点："))
           )
    (setq ang (angle p1 p2) l (distance p1 p2))
    (entmake
      (list
        '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        '(90 . 4)
        '(70 . 1)
        '(43 . 0.0)
        '(38 . 0.0)
        '(39 . 0.0)
        (cons 10 (trans (setq p(polar p1 (+ ang (* 0.5 pi)) (* 1 w))) 1 0))
        (cons 10 (trans (setq p (polar p ang l)) 1 0))
        (cons 10 (trans (setq p (polar p (- ang (* 0.5 pi)) w)) 1 0))
        (cons 10 (trans (setq p (polar p (+ pi ang) l)) 1 0))
        )
      )
    (princ "\n**继续输入")
    )
  (princ)
);defun

ucuc2003

香田里浪人 发表于 2013-5-29 14:03
;直线变矩形我也改了一点
(defun c:hjx(/ w p1 p2 ang )
(command "layer" "M" "矩形" "C" "4" "" "LT" ...

xingyun300

都是人才呀！学习学习！！！

q3_2006

最后一个最实用！

YJ647372

学习了。。。。。。。。。。。。。。