sailorcwx发表于2007-10-3 15:36:00static/image/common/back.gif什么是R角。锐角？
<p></p>R角是指圆弧，不是锐角。就是比如一个方孔四个角是圆角，转坐标的时候能不能把这圆弧的中点坐标也转出来。
ZZXXQQ发表于2007-10-5 10:20:00static/image/common/back.gif试试看能否满足要求。
<p></p>先感谢ZZXXQQ兄的帮忙，ZZXXQQ的这一段也只能转出槽孔每条线段的点，有圆角的也会跳过啊，并不能转出圆弧的中点。还有就是每个槽孔不能回到第一点，我的要求是每个槽孔转出来的坐标第一个跟最后一个是相同的。不过ZZXXQQ兄的这段也有个好处就是转了坐标的孔会变成白色，这点还是很感谢ZZXXQQ兄了。
这是带输出圆弧中点的程序。（可是有什么用呢？）
(DEFUN C:TT ()
(SETVAR "CMDECHO" 1)
(SETQ NM (IF NM NM ""))
(IF (SETQ NM (GETFILED "文件名" NM "txt" 1)) (PROGN
(SETQ F (OPEN NM "w"))
(WHILE (SETQ PT (GETPOINT "\n内部一点 :"))
(COMMAND "-BOUNDARY" PT "")
(COMMAND "EXPLODE" "L")
(SETQ S1 (SSGET "P"))
(SETQ I 0)
(SETQ ENT (ENTGET (SSNAME S1 I)))
(IF (= (CDR (ASSOC 0 ENT)) "LINE")
(SETQ PTL1 (LIST (CDR (ASSOC 10 ENT)) (CDR (ASSOC 11 ENT))))
(SETQ PC (CDR (ASSOC 10 ENT))
R (CDR (ASSOC 40 ENT))
ST (CDR (ASSOC 50 ENT))
ED (CDR (ASSOC 51 ENT))
PTL1 (LIST (POLAR PC ST R) (POLAR PC (- ED ST) R) (POLAR PC ED R)))
)
(REPEAT (1- (SSLENGTH S1))
(SETQ ENT1 (ENTGET (SSNAME S1 (SETQ I (1+ I)))))
(IF (= (CDR (ASSOC 0 ENT1)) "LINE")
(SETQ PTL2 (LIST (CDR (ASSOC 10 ENT1)) (CDR (ASSOC 11 ENT1))))
(SETQ PC (CDR (ASSOC 10 ENT1))
R (CDR (ASSOC 40 ENT1))
ST (CDR (ASSOC 50 ENT1))
ED (CDR (ASSOC 51 ENT1))
PTL2 (LIST (POLAR PC ST R) (POLAR PC (- ED ST) R) (POLAR PC ED R)))
)
(IF (EQUAL (DISTANCE (LAST PTL1) (CAR PTL2)) 0.0 0.03)
(SETQ PTL1 (APPEND PTL1 (CDR PTL2)))
(SETQ PTL1 (APPEND PTL1 (CDR (REVERSE PTL2))))
)
)
(COMMAND "ERASE" S1 "")
(SETQ I -1)
(REPEAT (LENGTH PTL1)
(SETQ PT (NTH (SETQ I (1+ I)) PTL1))
(PRINC (STRCAT "X" (RTOS (CAR PT) 2 3) " Y" (RTOS (CADR PT) 2 3) "\n") F)
)
(PRINC "\n" F)
)
(CLOSE F)
))
(SETVAR "CMDECHO" 1)
(PRINC)
)
<p>ZZXXQQ的转出带圆弧中点坐标的程式不对啊,比如一个10*10的方孔,四个角是R1的圆弧.</p><p>ZZXXQQ兄的程式转出坐标:</p><p>X10.000 Y9.000<br/>X9.000 Y10.000<br/>X9.000 Y10.000<br/>X1.000 Y10.000<br/>X1.000 Y10.000<br/>X0.000 Y9.000<br/>X0.000 Y1.000<br/>X1.000 Y2.000<br/>X1.000 Y0.000<br/>X9.000 Y0.000<br/>X9.000 Y2.000<br/>X10.000 Y1.000<br/>X10.000 Y9.000<br/></p><p>小弟想转出的坐标:</p><p>X10.000 Y9.000<br/>X9.707 Y9.707<br/>X9.000 Y10.000<br/>X1.000 Y10.000<br/>X0.293 Y9.707<br/>X0.000 Y9.000<br/>X0.000 Y1.000<br/>X0.293 Y0.293<br/>X1.000 Y0.000<br/>X9.000 Y0.000<br/>X9.707 Y0.293<br/>X10.000 Y1.000<br/>X10.000 Y9.000</p><p>ZZXXQQ兄能不能再改一改程式,转出坐标小弟是用在投影机上的.先谢谢了.</p>
(defun c:cs(/ X YH_BO YH_FILE YH_INDEX YH_LE YH_LPT YH_OBJ YH_PT YH_PT1 YH_PTL YH_PTL1 YH_RANGLE YH_RPT)
(vl-load-com)
(command)
(setq YH_ptl '())
(while (setq YH_pt1 (getpoint "\n选择孔内部点或者右键退出:"))
(setq YH_le (entlast))
(command "boundary" "a" "i" "n" "" "" YH_pt1 "")
(setq YH_bo (entlast))
(setq YH_ptl1 '())
(if (eq YH_le YH_bo)
(alert "错误，所选区域不封闭！")
(progn
(setq YH_rangle nil
YH_obj (vlax-ename->vla-object YH_bo)
)
(mapcar '(lambda (x)
(if (= (car x) 10)
(progn
(setq YH_pt (cdr x))
(if YH_rangle
(setq YH_lpt (last YH_ptl1)
YH_rpt (vlax-curve-getpointatparam YH_obj (/ (+ (vlax-curve-getparamatpoint YH_obj YH_pt)(vlax-curve-getparamatpoint YH_obj YH_lpt)) 2))
YH_ptl1 (append YH_ptl1 (list YH_rpt YH_pt))
YH_rangle nil
)
(setq YH_ptl1 (append YH_ptl1 (list YH_pt)))
)
)
)
(if (and (= (car x) 42) (/= (cdr x) 0))
(setq YH_rangle T)
)
)
(entget YH_bo))
(entdel YH_bo)
)
)
(if YH_ptl1 (setq YH_ptl (append YH_ptl (list (append YH_ptl1 (list (car YH_ptl1)))))))
)
(if YH_ptl
(progn
(setq YH_file (open "C:\\1.txt" "W")
YH_index 0
)
(repeat (length YH_ptl)
(setq YH_ptl1 (nth YH_index YH_ptl))
(write-line (strcat "======第" (rtos (1+ YH_index) 2 0) "个孔顶点坐标======") YH_file)
(mapcar '(lambda (x) (write-line (strcat "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl1)
(write-line "" YH_file)
(setq YH_index (1+ YH_index))
)
(close YH_file)
(startapp "notepad" "C:\\1.txt")
)
)
(princ)
)
<strong><font face="Verdana" color="#61b713">谢谢sailorcwx兄的帮忙。太感谢了！</font></strong>
<p><strong><font face="Verdana" color="#61b713">sailorcwx兄,首先感谢你的帮助,小弟用在投影机上的程式已经OK了,现在想稍微改一下你的程式用在CNC加工中心.还有点小问题,想请你再费心帮帮忙..小弟就是还想在"G01 Z-1.0F800"上面再加一行"G00 每个孔的第一个点X Y坐标",有空的话就帮我把第一行那个"****. nc"也改成当前图形的文件名.我用(setq filename(getvar "dwgname"))得出的文件是还带.dwg的文件名.你能不能改成只要数字的文件名,比如我当前图文件名是1234-m.dwg,能不能得出是1234.nc</font></strong></p><p><strong><font face="Verdana" color="#61b713"> (defun c:cs(/ X YH_BO YH_FILE YH_INDEX YH_LE YH_LPT YH_OBJ YH_PT YH_PT1 YH_PTL YH_PTL1 YH_RANGLE YH_RPT)<br/> (vl-load-com)<br/> (command)<br/> (setq YH_ptl '())<br/> (while (setq YH_pt1 (getpoint "\n选择孔内部点或者右键退出:"))<br/> (setq YH_le (entlast))<br/> (command "boundary" "a" "i" "n" "" "" YH_pt1 "")<br/> (setq YH_bo (entlast))<br/> (setq YH_ptl1 '())<br/> (if (eq YH_le YH_bo)<br/> (alert "错误，所选区域不封闭！")<br/> (progn<br/> (setq YH_rangle nil<br/> YH_obj (vlax-ename->vla-object YH_bo)<br/> )<br/> (mapcar '(lambda (x)<br/> (if (= (car x) 10)<br/> (progn<br/> (setq YH_pt (cdr x))<br/> (if YH_rangle<br/> (setq YH_lpt (last YH_ptl1)<br/> YH_rpt (vlax-curve-getpointatparam YH_obj (/ (+ (vlax-curve-getparamatpoint YH_obj YH_pt)(vlax-curve-getparamatpoint YH_obj YH_lpt)) 2))<br/> YH_ptl1 (append YH_ptl1 (list YH_rpt YH_pt))<br/> YH_rangle nil<br/> )<br/> (setq YH_ptl1 (append YH_ptl1 (list YH_pt)))<br/> )<br/> )<br/> )<br/> (if (and (= (car x) 42) (/= (cdr x) 0))<br/> (setq YH_rangle T)<br/> )<br/> )<br/> (entget YH_bo))<br/> (entdel YH_bo)<br/> )<br/> )<br/> (if YH_ptl1 (setq YH_ptl (append YH_ptl (list (append YH_ptl1 (list (car YH_ptl1)))))))<br/> )<br/> (if YH_ptl<br/> (progn<br/> (setq YH_file (open "C:\\1.txt" "W")<br/> YH_index 0<br/> )<br/> (write-line "%" YH_file)<br/> (write-line "(****.nc)" YH_file)<br/> (write-line "M06 T2 (D=3.0)" YH_file)<br/> (write-line "M08" YH_file)<br/> (write-line "G80G90G54F80" YH_file)<br/> (write-line "G00 X0.0 Y0.0 M03S2000" YH_file)<br/> (write-line "G43 H2 Z5.0" YH_file)<br/> (write-line "G01 F100 Z2.0" YH_file)<br/> (repeat (length YH_ptl)<br/> (setq YH_ptl1 (nth YH_index YH_ptl)) <br/> (write-line (strcat "N" (rtos (1+ YH_index) 2 0)) YH_file)<br/> (write-line "G01 Z-1.0F800" YH_file) <br/> (mapcar '(lambda (x) (write-line (strcat "G01" "X" (rtos (car X)) "Y" (rtos (cadr X))) YH_file)) YH_ptl1)<br/> (write-line "G00 Z5.0" YH_file)<br/> (write-line "M01" YH_file)<br/> (setq YH_index (1+ YH_index))<br/> )<br/> (write-line "G00 X0 Y0" YH_file)<br/> (write-line "M30" YH_file)<br/> (write-line "%" YH_file)<br/> (close YH_file)<br/> (startapp "notepad" "C:\\1.txt")<br/> )<br/> )<br/>(princ)<br/> ) <br/></font></strong></p><p><strong><font face="Verdana" color="#61b713"></font></strong></p>
<p>小弟想加的那行"G00 第一点坐标"已经解决,麻烦<strong><font face="Verdana" color="#61b713">sailorcwx兄指点一下怎么得出当前图形文件名?只要得出文件名的数字.比如当前图形文件名是1234-m.dwg,只要得出1234.谢谢</font></strong></p>
本帖最后由 作者 于 2007-10-15 23:06:02 编辑 <br /><br /> <p>;;更改了txt文件的位置，与dwg保存于同一位置<br/>;;修正了一个bug:当R角位于多段线最后一段时会遗漏R角中点，现已修正</p>
真的是太谢谢了。能不能在点选孔后就把这孔变一种颜色或者改成另一层，比如每点选一个孔后，点选过的孔就自动改到第4层或变成红色这样，以免漏选。