如何将选择的线段结合成pl线呢(已经解决)并执行vba的程序？(新手跪求)
本帖最后由 qcw911 于 2011-10-20 19:42 编辑(defun c:tt (/ gxl-Sel-ReDrawSel
gxl-Sel-SSsub gxl-Sel-SSJoin
gxl-sel-SSgetLineatPoint
getline
)
(defun gxl-Sel-ReDrawSel (Sel mode / m n)
(setq m (sslength Sel)
n 0
)
(repeat m
(redraw (ssname Sel n) mode)
(setq n (1+ n))
) ;repeat
)
(defun gxl-Sel-SSsub (ss1 ss2 / ss n)
(cond
((and ss1 ss2)
(setq n 0)
(repeat (sslength ss2)
(ssdel (ssname ss2 n) ss1)
(setq n (1+ n))
)
)
((and ss1 (not ss2))
ss1
)
(T
(setq ss1 nil)
)
)
ss1
)
(defun gxl-Sel-SSJoin(ss1 ss2 / ename ss cnt)
(ifss1
(progn
(if (= (type ss1) 'ENAME)
(progn
(setq
ename ss1
ss1 (ssadd)
)
(ssadd ename ss1)
)
)
)
)
(ifss2
(progn
(if (= (type ss2) 'ENAME)
(progn
(setq
ename ss2
ss2 (ssadd)
)
(ssadd ename ss2)
)
)
)
)
(setq ss (ssadd))
(if(and ss1 ss2)
(progn
;(setq ss ss2 cnt 0)
(setq cnt 0)
(repeat(sslength ss2)
(ssadd (ssname ss2 cnt) ss)
(setq cnt (1+ cnt))
)
(setq cnt 0)
(repeat(sslength ss1)
(ssadd (ssname ss1 cnt) ss)
(setq cnt (1+ cnt))
)
)
)
(if(and ss1 (not ss2))
(setq ss ss1)
)
(if(and ss2 (not ss1))
(setq ss ss2)
)
(if(> (sslength ss) 0)
;;(eval ss)
ss
nil
)
)
(defun gxl-sel-SSgetLineatPoint (pt jd / px py px0 px1 py0 py1 ss pz)
(setq px(car pt)
px0 (- px jd)
px1 (+ px jd)
py(cadr pt)
py0 (- py jd)
py1 (+ py jd)
pz(caddr pt)
)
(setq ss
(ssget "x"
(list'(0 . "line")
'(-4 . "<or")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 10 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 10 px1 py1 pz)
'(-4 . "and>")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 11 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 11 px1 py1 pz)
'(-4 . "and>")
'(-4 . "or>")
)
)
)
(ifss
(GXL-SEL-REDRAWSEL ss 3)
)
ss
)
(defun getline (pt jd / s s1 n p1 p2)
(setq s (gxl-sel-SSgetLineatPoint pt jd))
(ifs
(progn
(setq s1 (GXL-SEL-SSSUB s ssrtl)
ssrtl (GXL-SEL-SSJOIN ssrtl s1)
)
(if s1
(progn
(setq n 0)
(repeat (sslength s1)
(setq p1 (cdr (assoc 10 (entget (ssname s1 n))))
p2 (cdr (assoc 11 (entget (ssname s1 n))))
)
(getline p2 jd)
(getline p1 jd)
(setq n (1+ n))
)
)
)
)
)
)
(defun jion (/ ss s)
(setq ss (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(70 . 0)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(while ss
(setq s (ssname ss 0))
(if (or (= "LINE" (cdr (assoc 0 (entget s))))
(= "ARC" (cdr (assoc 0 (entget s))))
)
(command "pedit" s "y" "j" "p" "" "x")
(command "pedit" s "j" "p" "" "x")
)
(setq ss (ssget "p"))
)
(princ)
)
;;;程序开始
(princ "\n选择直线")
(setq enline (car (entsel)))
(initget 5 "")
;;;(setq jd (getreal "精确度<0.001>"))
;;;(if (= jd "")
(setq jd 0.001)
;;;)
(setq pt1 (cdr (assoc 10 (entget enline))))
(setq pt2 (cdr (assoc 11 (entget enline))))
(setq ssrtl (ssadd enline))
(getline pt1 jd)
(getline pt2 jd)
(sssetfirst nil ssrtl)
(jion)
;;;ssrtl
)
上面是GL_xl版主写的，选择一条直线，相邻的线段都选择怎样修改，将选择后的线段结合成pl线呢？ 不知道在哪里修改.
还有我公司用vba编写了程序命令行过程是这样的 vbastmt (setvar “filetrad” 200) Ckcase 用户选择线段
我编写 是 (command “vbastmt”) (setvar “filetrad” 200) (command “ckcase” pasue)这样行吗？我也不知道改到那里请大侠们帮帮忙 pedit命令就可以实现。 本帖最后由 qcw911 于 2011-10-18 08:17 编辑
ljttjl 发表于 2011-10-17 23:33 http://bbs.mjtd.com/static/image/common/back.gif
pedit命令就可以实现。
我是新手
这个我知道
如何修改呢
帮帮忙 查看autocad命令帮助文件 本帖最后由 qcw911 于 2011-10-19 09:00 编辑
ljttjl 发表于 2011-10-18 22:23 http://bbs.mjtd.com/static/image/common/back.gif
查看autocad命令帮助文件
这个是我找到的程序
但是结合VBA就不行了
命令行过程是这样的 vbastmt (setvar “filetrad” 200) Ckcase 用户选择线段
我编写 是 (command “vbastmt”) (setvar “filetrad” 200) (command “ckcase” pasue)这样行吗？插写在那里(vl-load-com)
(defun gotonexten (en pt / box en2 en2lst ep i sp ss)
(setq box (* (/ (getvar "pickbox") (cadr (getvar "screensize")))
(getvar "viewsize")
)
)
(setq ss (ssget "c"
(mapcar '- pt (list box box))
(mapcar '+ pt (list box box))
)
)
(if ss
(progn
(ssdel en ss)
(setq i 0)
(while (setq en2 (ssname ss i))
(setq i (1+ i))
(setq
sp (vl-catch-all-apply 'vlax-curve-getStartPoint (list en2))
)
(if (listp sp)
(progn (setq ep (vlax-curve-getEndPoint en2))
(cond ((equal sp pt 1e-8)
(setq en2lst (cons (list en2 ep) en2lst))
)
((equal ep pt 1e-8)
(setq en2lst (cons (list en2 sp) en2lst))
)
)
)
)
)
)
)
en2lst
)
;楢銛楢慄c:ss-----fsxm2007/01/29
(defun c:ss (/ en enp ept spt ss addnext)
(if (and (setq enp (entsel))
(ssget (cadr enp) '((0 . "*line,arc,circle,ellipse")))
)
(progn
(setq en (car enp))
(setq spt (vlax-curve-getStartPoint en))
(setq ept (vlax-curve-getendPoint en))
(setq ss (ssadd))
(ssadd en ss)
(defun addnext (en pt / next)
(if (setq next (gotonexten en pt))
(foreach a next
(if (not (ssmemb (car a) ss))
(progn (ssadd (car a) ss)
(apply 'addnext a)
)
)
)
)
)
(addnext en spt)
(addnext en ept)
(if (= 0 (getvar "cmdactive"))
(sssetfirst nil ss)
)
ss
(jion)
)
(progn
(princ "\n枹?庢?徾埥?庢椆旕curve?宆?徾!")
(princ)
)
)
)
(defun jion (/ ss s)
(setq ss (ssget '((-4 . "<OR")
(0 . "LINE")
(0 . "ARC")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(70 . 0)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(while ss
(setq s (ssname ss 0))
(if (or (= "LINE" (cdr (assoc 0 (entget s))))
(= "ARC" (cdr (assoc 0 (entget s))))
)
(command "pedit" s "y" "j" "p" "" "x")
(command "pedit" s "j" "p" "" "x")
)
(setq ss (ssget "p"))
)
(princ)
) 跪求，那位高手能来相助啊 帖子快沉了，是不是我没说明白啊？
页:
[1]