【求洞口线的绘制】已解决！~~
本帖最后由 daidong013 于 2011-7-5 22:52 编辑经常用到画洞口线，求这样的洞口线绘制工具！~~
zhynt 发表于 2011-6-29 14:26
坐在板凳上给你写：
能支持框选吗批量画洞口并且填充 zhynt 发表于 2011-6-29 14:26
坐在板凳上给你写：
能支持点选空间就好了 更快捷 自己坐个沙发@！~顶一下！~~ 坐在板凳上给你写：
(defun err (s)
(if (and
(/= s "console break")
(/= s "Function cancelled")
(/= s "quit/exit abort")
)
(progn
(setvar "LUPREC" oldlup)
(setvar "LUNITS" oldlun)
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setvar "clayer" oldlay)
(setq *error* olderr)
(princ (strcat "\n程序出错或用户退出:" s))
)
)
)
(defun bak ()
(command "_.undo" "be")
(setq oldos (getvar "osmode")
oldcmd (getvar "cmdecho")
oldlun (getvar "LUNITS")
oldlup (getvar "LUPREC")
olderr *error*
*error* err
oldlay (getvar "clayer")
)
)
(defun rebak ()
(setvar "osmode" oldos)
(setvar "cmdecho" oldcmd)
(setvar "clayer" oldlay)
(setvar "LUPREC" oldlup)
(setvar "LUNITS" oldlun)
(command "_.undo" "e")
)
(setq real 20.0)
(defun c:dk (/ dk_pt1 dk_pt2 dk_pt3 dk_pt4
dk_kd nk_pt1 nk_pt2 nk_pt3 nk_pt4
olds oldcmd oldlup oldlay nk_n
nk_kd ptax ptay ptaz ptbx
ptby ptbz l_pt1_pt4 l_pt2_pt3 l_n
ang_pt1_pt4
)
(bak)
(setvar "cmdecho" 0)
(setvar "LUPREC" 8)
(setvar "LUNITS" 2)
(if (= (TBLOBJNAME "LAYER" "PUB_HATCH") nil)
(command "layer" "m" "PUB_HATCH" "c" "8" "" "")
)
(if (= (TBLOBJNAME "LAYER" "PUB_DIM") nil)
(command "layer" "m" "PUB_DIM" "c" "3" "" "")
)
(setq dk_pt1 (getpoint "\n指定第一角点:[退出]"))
(if (/= dk_pt1 nil)
(progn
(setq dk_pt3 (getcorner dk_pt1 "\n指定第二角点:[退出]"))
(if (/= dk_pt3 nil)
(progn
(setq dk_real
(getreal
(strcat "\n输入边框宽度:<"
(rtos real 2 4)
">:"
)
)
)
(if (= dk_real nil)
(setq dk_real real)
(setq real dk_real)
)
(setq dk_ptn (list (min (car dk_pt1) (car dk_pt3))
(min (cadr dk_pt1) (cadr dk_pt3))
)
dk_pt3 (list (max (car dk_pt1) (car dk_pt3))
(max (cadr dk_pt1) (cadr dk_pt3))
)
dk_pt1 dk_ptn
)
(setq ptax (car dk_pt1)
ptay (cadr dk_pt1)
ptbx (car dk_pt3)
ptby (cadr dk_pt3)
)
(setq dk_pt2 (list ptax ptby)
dk_pt4 (list ptbx ptay)
dk_pt5 (polar dk_pt2 (/ (* pi 7.0) 4) (* dk_real (sqrt 2)))
)
(if (< oldos 16384)
(setvar "osmode" (+ oldos 16384))
)
(setvar "clayer" "pub_dim")
(command "_.pline" dk_pt1 dk_pt2 dk_pt3 dk_pt5 "C")
(setq dk_ss (entlast))
(command "_.BHATCH" "s" dk_ss "" "la" "pub_hatch" "p" "s" "")
)
)
)
)
(rebak)
(princ)
)
本帖最后由 daidong013 于 2011-6-29 15:08 编辑
回复 zhynt 的帖子
还是Z版大侠热心！~~程序不错！~~
就是画的时候出现以下情况，有pl框但填充没有另外捕捉也失效了！~~是什么问题？~~~（请教）要怎么改！~
指定第一角点:[退出]
指定第二角点:[退出]
输入边框宽度:<20>:
需要二维角点或选项关键字。
程序出错或用户退出:函数被取消
指定内部点或
[特性(P)/选择对象(S)/绘图边界(W)/删除边界(B)/高级(A)/绘图次序(DR)/原点(O)]:
图案填充间距太密，或短划尺寸太小。
再请教一下：如果直接填充改成solid的填充可能不会出现这样的问题了吧？
或者能设一下填充的样式、比例、和角度!
本帖最后由 zhynt 于 2011-6-29 15:11 编辑
我是在2012上写的，以前版本BHATCH选项与现在的不一样，所以出问题了。
这是2012的bhatch选项：
[特性(P)/选择对象(S)/绘图边界(W)/删除边界(B)/高级(A)/绘图次序(DR)/原点(O)/注释性(AN)/图案填充颜色(CO)/图层(LA)/透明度(T)]:
2008的选项：
[特性(P)/选择对象(S)/绘图边界(W)/删除边界(B)/高级(A)/绘图次序(DR)/原点(O)/注释性(AN)]:
本帖最后由 daidong013 于 2011-6-29 15:12 编辑
回复 zhynt 的帖子
那要怎么改一下呢？
或者能设一下填充的样式、比例、和角度再不行就把填充改成solid!~~
请将
(command "_.BHATCH" "s" dk_ss "" "la" "pub_hatch" "p" "s" "")
替换改为
(if (= (substr (getvar "acadver") 1 2) "18")
(command "_.BHATCH" "s" dk_ss "" "la" "pub_hatch" "p" "s" "")
(progn
(setvar "clayer" "pub_hatch")
(command "_.BHATCH" "s" dk_ss "" "p" "s" "")
)
)
回复 daidong013 的帖子
我设的就是solid 回复 zhynt 的帖子
可以了！~~感谢啊！~~Z版大侠应该成为版主！~~
活雷锋！~~对您表示敬意！~~ 再请教一下！~~如果要改填充图案式样要在那里改！~~
( 图案样式ANSI31---比例100---角度为0 )