crazylsp 发表于 2013-9-20 19:03:32

节日空闲编的

本帖最后由 crazylsp 于 2013-9-20 19:07 编辑

请教问题,有无知道的可讨论下
;;-----问题 1 .求交点用的辅助线无法删除
;;               2 .程式出错后用户定义的错误处理函数只能错误处理一次( 回车可继续)
程序思路 选择边界线
               引用子函数: 画辅助线
                               辅助线和它选择的线集合求交点 ，找出交点距最近的边界线
                               与最近边界线有无交点判断修剪延伸
                当发生参数类型错误(: 二维/三维点: #<safearray...>)引用用户定义的错误处理函数
命令TK

669423907 发表于 2013-9-20 19:21:02

本帖最后由 669423907 于 2013-9-20 19:22 编辑

;两点修剪 hao3ren 2013-7-5 http://bbs.mjtd.com/thread-95193-1-1.html
(defun c:5t()
(setq pt1 (getpoint "\n指定第1点："))
(setq pt2 (getpoint pt1 "\n指定第2点："))
(setq pt3 (getpoint "\n指定第3点："))
(grdraw Pt1 pt2 1)
(command "line" pt1 pt2 "")
(setq tg (entLast))
(command "trim" tg "" "f" pt1 pt3 pt2 "" "")
(entdel tg))

不是源码

crazylsp 发表于 2013-9-20 19:59:30

谢谢，你的思路很好，但是
1不能切换延伸，
2由用户指定方向点pt3不够方便，试用交点作方向点。
修改一点
(defun c:5t()
(setq pt1 (getpoint "\n指定第1点："))
(setq pt2 (getpoint pt1 "\n指定第2点："))
(grdraw Pt1 pt2 1)
(command "line" pt1 pt2 "")
(setq tg1 (entLast)
      tgo1(vlax-ename->vla-object tg1)
      s   (ssget "f" (list pt1 pt2))
      sl(sslength s)
      n   0
)
(repeat sl
(setq tg2 (ssname s n)
       tgo2(vlax-ename->vla-object tg2)
       pt3 (vlax-variant-value (vla-intersectwith tgo1 tgo2 0))
       n   (1+ n)
)
(if (> (vlax-safearray-get-u-bound pt3 1) 0) (progn
(setq pt3(vlax-safearray->list pt3))
(command "trim" "" (list tg2 pt3) "")
))
)
(entdel tg1)
)

669423907 发表于 2013-9-20 22:28:22

crazylsp 发表于 2013-9-20 19:59 static/image/common/back.gif
谢谢，你的思路很好，但是
1不能切换延伸，
2由用户指定方向点pt3不够方便，试用交点作方向点。


不是我写的喔。
顺便帮看看院长的这个能不能改成在确定第二点后自动确认呢

;选线延伸 xyp1964 2012-3-29 http://bbs.mjtd.com/thread-92657-1-1.html
(defun c:t5(/ ss1)
(Princ "\n选择延伸线: ")
(while (not (setq ss1 (ssget":s"))))
(Princ "选择被延伸线: ")
(command "extend" ss1 "" "f")
(princ))

crazylsp 发表于 2013-9-21 13:07:28

;改好了建议全选，增加程序方便性，要不然和普通延伸没有不同了。
;如果加入判断修剪延伸这个程序就OK又简洁，但得想办法在命令平台外执行，你们都想想办法
(defun c:tt(/ ss1)
(Princ "\n选择延伸线: ")
;(setq ss1 (ssget":s"))
(setq ss1 (ssget"X"))
(Princ "选择被延伸线: ")
(command "extend" ss1"" )
( while (> (getvar 'CmdActive) 0) ;当不退出命令平台时候做两点延伸
(command "f" pause pause "" )
)
(command "")
(princ)
)

669423907 发表于 2013-9-21 20:29:08

crazylsp 发表于 2013-9-21 13:07 static/image/common/back.gif
;改好了建议全选，增加程序方便性，要不然和普通延伸没有不同了。
;如果加入判断修剪延伸这个程序就OK又简 ...

全选大图可能不是很好，这个如何？
;选择可见对象 hbllw 2010-11-6 http://bbs.mjtd.com/thread-75263-2-1.html
(defun m,( / $screen atio ce ch ch2 hh hh2 k p1 p2 ss)
(setq $screen (getvar "SCREENSIZE"))
(setq ch (getvar "viewsize"))
(setq ch2 (/ ch 2)) (setq ce (getvar "viewctr"))
(setq atio (/ (car $screen) (cadr $screen)))
(setq hh (* atio ch))
(setq hh2 (/ hh 2))
(setq p1 (polar (polar ce 0 hh2)
(* 1.5 pi) ch2))
(setq p2 (polar (polar ce pi hh2)
(* 0.5 pi) ch2))
(setq SK (ssget "C" p1 p2))
(princ))

crazylsp 发表于 2013-9-21 21:13:47

很好的方法screen是虚屏吗？
页: [1]
查看完整版本: 节日空闲编的