LISP程序]：装修作图之等分程序

xyp1964

[php]
;;等分 c:df
;-- XYP@bsedi.com 2004.10.19
(defun c:DFf (/ pt1 pt2 dx ang1 ang2 ptn n)
  (setvar "osmode" 39)
  (while (not (setq pt1 (getpoint "\n\t第一点："))))
  (while (not (setq pt2 (getpoint pt1 "\n\t第二点："))))
  (If no3
    (setq no3 (fix no3))
  )
  (While (not (setq no3 (ureal 1 "" "\n\t份数" no3))))
  (if (and (/= no3 0) (/= no3 ""))
    (setq dx (/ (distance pt1 pt2) no3))
  )
  (setq ang1 (angle pt1 pt2))
  (setq ang2 (- ang1 (/ pi 2)))
  (setvar "osmode"0)
  (command "line" pt1 (polar pt1 ang2 1000) "")
  (setq n 1)
  (while (< n no3)
    (setq ptn (polar pt1 ang1 dx))
    (command "line" ptn (polar ptn ang2 1000) "")
    (setq pt1 ptn
          n   (+ 1 n)
    )
  )
  (command "line" pt2 (polar pt2 ang2 1000) "")
  (princ)
)
(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)
  )
[/php]

snsj

(defun ureal (bit kwd msg def / inp)
改为(defun uint .....)
建议：选两点改为点选线
      点选线后显示线长度，以便确定等分数量
      等分线的距离最好由用户确定

xyp1964

最初由 snsj 发布
[B](defun ureal (bit kwd msg def / inp)
改为(defun uint .....)
建议：选两点改为点选线
      点选线后显示线长度，以便确定等分数量
      等分线的距离最好由用户确定 [/B]

1. “改为(defun uint .....)”？
2. 一般来说，装修图是在已有空间（固定尺寸）作划分，如果由用户确定等分线的距离，可能分不均匀。是否可以让用户输入一个大概的距离，再判断可以分几段，然后取整后等分。
有空时再改改。
[php]
;|等分
c:df
-- XYP@bsedi.com
2004.10.19
A 2004.10.22
|;
(defun c:DF (/ pt1 pt2 dist dx ang1 ang2 ptn n)
(cmdla0)
  (setvar "osmode" 39)
  (while (not (setq pt1 (getpoint "\n\t第一点："))))
  (while (not (setq pt2 (getpoint pt1 "\n\t第二点："))))
  (setq dist (abs (distance pt1 pt2)))
  (princ "\n\t两点间距离 : ")
  (princ dist)
  (If no3
    (setq no3 (fix no3))
  )
  (While (not (setq no3 (ureal 1 "" "\n\t份数" no3))))
  (if (and (/= no3 0) (/= no3 ""))
    (setq dx (/ (distance pt1 pt2) no3))
  )
  (setq ang1 (angle pt1 pt2))
  (setq ang2 (- ang1 (/ pi 2)))
  (setvar "osmode" 0)
  (mkla "等分线" 4)
  (command "line" pt1 (polar pt1 ang2 (/ dist no3)) "")
  (setq n 1)
  (while (< n no3)
    (setq ptn (polar pt1 ang1 dx))
    (command "line" ptn (polar ptn ang2 (/ dist no3)) "")
    (setq pt1 ptn
          n   (+ 1 n)
    )
  )
  (command "line" pt2 (polar pt2 ang2 (/ dist no3)) "")
(cmdla1)
)
(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 (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
  )
)
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
  )

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
  )
[/php]

andyhua5240

下载了，非常的好使，建议楼主改为：
等分完成后，返回用户的图层，而不是在等分线图层。
谢谢！

snsj

1。是因为你原来的程序有错误
下次贴代码的时候在代码的前后分别加上[ php]和[/php]就可以得到彩色显示效果，这次我帮你编辑了一下
具体还不太清楚在装修图中具体的使用对象还请指点，顺便用另一种方法也写了一个：
[php]
(defun c:df (/ pt1 pt2 a b nb kj n x)
(setq pt1 (getpoint "\n第一点:")n -1)
(setq pt2(getpoint pt1"\n第二点:"))
(princ(strcat"\n两点距离为:"(rtos(setq b(distance pt1 pt2))2)))
(setq nb (getint"\n等分数:"))
(vl-cmdf ".line" pt1 pt2 "")(setq a(entlast))
(repeat (1+ nb)
(setq kj(cons(vlax-curve-getPointAtDist a(*(/ b nb)(1+ n)))kj))
  (setq n(1+ n))
  )
(mapcar'(lambda(x)
(vl-cmdf ".line" x (polar x (-(angle pt1 pt2)(/ pi 2))(/ b nb)) "")
          )kj
       )(vl-cmdf ".erase" a "")(princ)
)
[/php]

andyhua5240

谢谢斑竹，您老的程序真是太好了，要是能适用于样条、曲线，就更完美了！
谢谢！

xyp1964

最初由 andyhua5240 发布
[B]下载了，非常的好使，建议楼主改为：
等分完成后，返回用户的图层，而不是在等分线图层。
谢谢！ [/B]

谢谢提建议，已改。

另：
斑竹的东东就是简洁，不过就是不太懂，只好查查“字典”了。
为什么“等分数”不设成记忆呢？

xxxyzxx

恩，楼上的兄弟知道的都太多了，我要努力学习～

自由的鱼

好程序！！

狂刀

长老的回帖有点灌水的嫌疑哦，呵呵

zb_lou

我平常经常是要等分物体的。所以我就自己编了一个很小的程序。我自己觉得很好用。
可以等分所有的线条。(请指教)

andyhua5240

楼上的程序不能用呀？CAD2004

zb_lou

我平常都使用CAD14，没什么问题啊。在CAD2004的时候可能是其中“erase”命令要作改动。

andyhua5240  
我重新修改了，在CAD2004上试过可用。

heroaming

如何等分长方形或封闭的多变形等．选择对象后能自动闭合（如果不闭合或需修整）．然后等分
我常需要对沿街建筑（长方行、扇行等店面）进行分割，然后标上地名号（门牌号

xotoo

这个程序实在是太帅了，过去竟然没有发现……以后再等分柜体啊什么的东西的时候终于方便了……