求双线墙体绘制的LISP源程序

zengsijun

我想要一个双线墙绘制的LISP源程序,要求,可以实现双线直墙与双线弧墙的切换,类似晓东工具箱\建荣工具箱里的墙线绘制工具!哪位高手能提供源码?本不不甚感激!!!

szx025

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

(defun C:WL (/ L1 L2 PT1 PT2 PT3 PT4 KU)

    (if (setq L1 (getpoint "\nPick point:"))
 (progn
     (setq OLD_CMDECHO (getvar "CMDECHO"))
     (setvar "CMDECHO" 0)
     (setq CL (getvar "clayer"))
            (setvar "EDGEMODE" 1)
     (command "-layer" "m" "WALL" "C" "1" "" "")
     ;LINEWID 存储多段线的缺省宽度
     (setvar "PLINEWID" 60)
     (while (setq L2 (getpoint L1 "\nPick point:"))

  (setq KU (angle L1 L2))
  (setq PT1 (polar L1 (+ KU (* 0.5 pi)) 120))
  (setq PT2 (polar L1 (+ KU (* 1.5 pi)) 120))
  (setq PT3 (polar L2 (+ KU (* 0.5 pi)) 120))
  (setq PT4 (polar L2 (+ KU (* 1.5 pi)) 120))

  ;;绘制
  (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)
 )
    )
    (princ)
)

fengsea

不能设定墙线的宽度，不好用！而且画完了不能闭合终端的线，改下会很方便的

cxs259

看看这个

(defun c:dl()
(if (= wwdy nil) (setq wwdy 240))
(setq str1 (rtos wwdy 2 2))
(prompt "\n  now dline width is: ")
(prompt str1)
(setq pt1 (getpoint "\n enter start point:"))
(setq pt2 (getpoint pt1 "\n enter next point:"))
(setq dis1 (* 0.5 wwdy))
(setq ag1 (angle pt1 pt2))
(setq pt1u (polar pt1 (+ ag1 1.5708) dis1))
(setq pt2u (polar pt2 (+ ag1 1.5708) dis1))
(setq pt1d (polar pt1 (- ag1 1.5708) dis1))
(setq pt2d (polar pt2 (- ag1 1.5708) dis1))
(command "pline" "non" pt1u "non" pt2u "")
(command "pline" "non" pt1d "non" pt2d "")
(repeat 100
   (setq pt1 pt2)
   (setq pt2 (getpoint pt1 "\n enter next point:"))
   (setq dis1 (* 0.5 wwdy))
   (setq ag1 (angle pt1 pt2))
   (setq pt1u (polar pt1 (+ ag1 1.5708) dis1))
   (setq pt2u (polar pt2 (+ ag1 1.5708) dis1))
   (setq pt1d (polar pt1 (- ag1 1.5708) dis1))
   (setq pt2d (polar pt2 (- ag1 1.5708) dis1))
   (command "pline" "non" pt1u "non" pt2u "")
   (command "pline" "non" pt1d "non" pt2d "")
)
)

tianyi1230

默认为240墙线了

lxy_2080

好像挺好，留记号，明天电脑试下