[求助]帮忙改进

rark123 · 发表于 2005-3-6 22:32:00

功能是：生成简易房的程序。

谢谢

xyp1964 · 发表于 2005-3-7 20:42:00

应增加高度控制：

;;;生成简易房的程序
(defun c:jyf ()
(setvar "osmode" 1)
(setq ename (car (entsel "\n选择实体 : "))
no1 (ureal 1 "" "\n墙高" no1)
)
(mkla "jmd" 1)
(setq dy 0)
(if ename
(progn
(setq d nil
lb (entget ename)
bh (cdr (assoc 70 lb))
)
(setq b (cdr (assoc 0 lb)))
(if (= b "POLYLINE")
(progn
(command "change" ename "" "p" "la" "jmd" "thickness" NO1 "")
(setq sut (entnext ename))
(while (/= (cdr (assoc 0 (entget sut))) "SEQEND")
(setq pt (cdr (assoc 10 (entget sut)))
x1 (nth 0 pt)
y1 (nth 1 pt)
z1 (list x1 y1)
d (cons z1 d)
sut (entnext sut)
)
) ;end while
(setq dy (length d))
(if (= dy 4)
(progn
(setq xy1 (nth 0 d)
xy11 (nth 2 d)
a1 (angle xy1 xy11)
)
(if (> a1 3.14)
(setq a1 (- 7.85 a1))
)
(setq xy2 (nth 1 d)
xy12 (nth 3 d)
a2 (angle xy2 xy12)
)
(if (> a2 3.14)
(setq a2 (- 7.85 a2))
)
(setq xy3 (nth 2 d)
xy13 (nth 0 d)
a3 (angle xy3 xy13)
)
(if (> a3 3.14)
(setq a3 (- 7.85 a3))
)
(setq xy4 (nth 3 d)
xy14 (nth 1 d)
a4 (angle xy4 xy14)
)
(if (> a3 3.14)
(setq a3 (- 7.85 a3))
)
(setq minvale (min a1 a2 a3 a4))
(cond ((= minvale a1) (command "line" (nth 0 d) (nth 2 d)))
((= minvale a2) (command "line" (nth 1 d) (nth 3 d)))
((= minvale a3) (command "line" (nth 2 d) (nth 0 d)))
((= minvale a4) (command "line" (nth 3 d) (nth 1 d)))
)
(command "")
(command "change"
(entlast)
""
"p"
"la"
"jmd"
"thickness"
no1
""
)
)
)
(if (/= dy 4)
(progn
(setq point1 (getpoint "\n第一点:"))
(setq point2 (getpoint "\n第二点:"))
(command "line" point1 point2 "")
(command "change"
(entlast)
""
"p"
"la"
"jmd"
"thickness"
no1
""
)
)
)
)
)
(if (or (= b "LINE") (= b "LWPOLYLINE"))
(alert "错: LINE or lwpolyline ")
)
)
)
)
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)
(defun mkla (name color)
(If (= (Tblsearch "layer" name) nil)
(Command "layer" "m" name "c" color name "")
(Command "layer" "t" name "s" name "c" color name "")
)
)

;;;生成简易房的程序
(defun c:jyf ()
   (setvar "osmode" 1)
   (setq  ename (car (entsel "\n选择实体 : "))
  no1     (ureal 1 "" "\n墙高" no1)
   )
   (mkla "jmd" 1)
   (setq dy 0)
   (if ename
       (progn
           (setq d   nil
         lb (entget ename)
         bh (cdr (assoc 70 lb))
           )
           (setq b (cdr (assoc 0 lb)))
           (if (= b "POLYLINE")
  (progn
     (command "change" ename "" "p" "la" "jmd" "thickness"  NO1 "")
     (setq sut (entnext ename))
     (while (/= (cdr (assoc 0 (entget sut))) "SEQEND")
         (setq pt   (cdr (assoc 10 (entget sut)))
       x1   (nth 0 pt)
       y1   (nth 1 pt)
       z1   (list x1 y1)
       d     (cons z1 d)
       sut (entnext sut)
         )
     )        ;end while   
     (setq dy (length d))
     (if (= dy 4)
         (progn
             (setq xy1   (nth 0 d)
           xy11 (nth 2 d)
           a1   (angle xy1 xy11)
             )
             (if (> a1 3.14)
    (setq a1 (- 7.85 a1))
             )
             (setq xy2   (nth 1 d)
           xy12 (nth 3 d)
           a2   (angle xy2 xy12)
             )
             (if (> a2 3.14)
    (setq a2 (- 7.85 a2))
             )
             (setq xy3   (nth 2 d)
           xy13 (nth 0 d)
           a3   (angle xy3 xy13)
             )
             (if (> a3 3.14)
    (setq a3 (- 7.85 a3))
             )
             (setq xy4   (nth 3 d)
           xy14 (nth 1 d)
           a4   (angle xy4 xy14)
             )
             (if (> a3 3.14)
    (setq a3 (- 7.85 a3))
             )
             (setq minvale (min a1 a2 a3 a4))
             (cond ((= minvale a1) (command "line" (nth 0 d) (nth 2 d)))
           ((= minvale a2) (command "line" (nth 1 d) (nth 3 d)))
           ((= minvale a3) (command "line" (nth 2 d) (nth 0 d)))
           ((= minvale a4) (command "line" (nth 3 d) (nth 1 d)))
             )
             (command "")
             (command "change"
                 (entlast)
                 ""
                 "p"
                 "la"
                 "jmd"
                 "thickness"
                 no1
                 ""
             )
         )
     )
     (if (/= dy 4)
         (progn
             (setq point1 (getpoint "\n第一点:"))
             (setq point2 (getpoint "\n第二点:"))
             (command "line" point1 point2 "")
             (command "change"
                 (entlast)
                 ""
                 "p"
                 "la"
                 "jmd"
                 "thickness"
                 no1
                 ""
             )
         )
     )
  )
           )
           (if (or (= b "LINE") (= b "LWPOLYLINE"))
  (alert "错: LINE or lwpolyline ")
           )
       )
   )
)
(defun ureal (bit kwd msg def / inp)
   (if def
       (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
                   bit (* 2 (fix (/ bit 2)))
       )
       (setq msg (strcat "\n" msg ": "))
   )
   (initget bit kwd)
   (setq inp (getreal msg))
   (if inp inp def)
)
(defun mkla (name color)
   (If (= (Tblsearch "layer" name) nil)
       (Command "layer" "m" name "c" color name "")
       (Command "layer" "t" name "s" name "c" color name "")
   )
)

004 · 发表于 2012-12-3 04:58:05

xyp1964前辈,测绘的简易房表示很简单,就是房屋边上中间加条对角线,不存在高度控制.

账号		自动登录	找回密码
密码			注册

[求助]帮忙改进

本帖子中包含更多资源

浏览过的版块