[原创]：画墙线的lisp

szx025

;;;--------外墙线----------

(defun C:WL (/ L1 L2 PT1 PT2 PT3 PT4 KU S1 S2 S3 S4 )
(setq old_OS  (getvar "OSMODE")
            OLD_CMDECHO (getvar "CMDECHO"))
            (setvar "CMDECHO" 0)
            (setvar "osmode" 32)
    (if        (setq L1 (getpoint "\nPick point:"))
        (progn
        (setq    w         (if (null WL_dist)
               (getdist "\n 外宽值为<>:")
               (getdist (strcat "\n当前外宽值为<" (rtos WL_dist) ">:"))
             )
    WL_dist (if (null w)
               WL_dist
               w
             )
  )
(setq    h         (if (null hL_dist)
               (getdist "\n 内宽值为<>:")
               (getdist (strcat "\n当前内宽值为<" (rtos hL_dist) ">:"))
             )
    hL_dist (if (null h)
               hL_dist
               h
             )
  )
                      (setq CL (getvar "clayer"))
            (setvar "EDGEMODE" 1)
            (command "-layer" "m" "WALL" "C" "31" "" "")
            ;;PLINEWID 存储多段线的缺省宽度
            (setvar "PLINEWID" 60)
            (while (setq L2 (getpoint L1 "\nPick point:"))
                (setq KU (angle L1 L2))
                (setq PT1 (polar L1 (+ KU (* 0.5 pi)) WL_dist))
                (setq PT2 (polar L1 (+ KU (* 1.5 pi)) hL_dist))
                (setq PT3 (polar L2 (+ KU (* 0.5 pi)) WL_dist))
                (setq PT4 (polar L2 (+ KU (* 1.5 pi)) hL_dist))
                ;;绘制
                (command "_.Pline" "non" PT1 "non" PT3 "")
                (setq ENT13 (entlast)
                      S1    (list ENT13 PT1)
                )
                (command "_.Pline" "non" PT2 "non" PT4 "")
                (setq ENT24 (entlast)
                      S2    (list ENT24 PT2)
                )
                ;;对上一交点处尝试进行修剪或延伸
                (if S3
                    (progn
                        (command "_.TRIM" S1 S3 "" S1 S3 "")
                        (command "_.TRIM" S2 S4 "" S2 S4 "")
                        (command "_.EXTEND" S1 S3 "" S1 S3 "")
                        (command "_.EXTEND" S2 S4 "" S2 S4 "")
                    )
                )
                ;;为下一段做准备
                (setq S3 (list ENT13 PT3)
                      S4 (list ENT24 PT4)
                      L1 L2
                )
            )
            ;;图层名称应是字符串
            (setvar "clayer" CL)
            (setvar "CMDECHO" OLD_CMDECHO)
             (setvar "OSMODE" old_OS)
        )
    )
    (princ)
)
画墙的lisp.有点问题，请高人完善
1.只能顺时针进行
2.起点和终点的线不能封闭

露水2

二次相交时不能修剪