修改的轮廓的新程序

linear

上面的最后一步没改完。改为 (setq e (ssname p1 (- (sslength ss) 1)))
(setq tp1 (entget e))

(setq ee (ssname p2 (- (sslength ss) 1)))
(setq tp2 (entget ee)) 下面运行到(- (cadr p0) 0.001)出错，显示cadr p0为nil. (command "fillet"
(list en1 (list (car p0) (- (cadr p0) 0.001)))
(list en2 p00)
) 谢谢

meflying

你给个测试图、相对完整的程序及一组输入数据，这样才可以看结果，


另：你说的“返回”是指半途跟踪值还是程序执行完后的结果？

linear

我画了个圆，对它操作的。 返回是半途跟踪值。 (Defun c:bl (/ l ll)
(setq a (getpoint "internal point:"))
(setq p (getpoint "base point:"))
(command "-boundary" "_a" "_o" "_r" "_i" "_y" "_b" "_n" "" "" a "")
(command "move" "l" "" p "@5,-5")
(command "-color" 9)
(command "hatch" "u" 0 0.1 "n" "l" "")
(command "explode" "l" "")

(vl-load-com)
(setq ss (ssget "x" ' ((62 . 9))))
(setq i 0)
(setq p1 (ssadd))
(setq p2 (ssadd))
(repeat (sslength ss)
(setq ent (ssname ss i))
(setq ens (vlax-Ename->Vla-Object ent))
(setq l (vlax-curve-getdistatparam ens
(vlax-curve-getendparam ens)
)
)

(setq ll (+ (EXPT l 3.0) l 1.0))
(setq dx (/ (- ll l) 2))

(setq le (entget ent))
(setq pt1x (car (assoc 10 le)))
(setq pt1y (cadr (assoc 10 le)))
(setq pt1z (caddr (assoc 10 le)))
(setq pt1 (list (- pt1x dx) pt1y pt1z)) (setq p1 (ssadd (entlast) p1))

(setq le (entget ent))
(setq pt2x (car (assoc 11 le)))
(setq pt2y (cadr (assoc 11 le)))
(setq pt2z (caddr (assoc 11 le)))
(setq pt2 (list (+ pt2x dx) pt2y pt2z)) (setq p2 (ssadd (entlast) p2))

(entdel ent)
(setq i (1+ i))
)
(setq ff (ssname p1 0))
(setq p0 (entget ff))
(setq p00 (entget (ssname p2 0)))
(setq py (cadr p0))

(setq e (ssname p1 (- (sslength ss) 1)))
(setq tp1 (entget e))
(setq ee (ssname p2 (- (sslength ss) 1)))
(setq tp2 (entget ee))

(command "pline" p0 "a" p1 "")
(setq en1 (entlast))

(command "pline" p00 "a" p2 "")
(setq en2 (entlast)) (command "fillet"
(list en1 (list (car p0) (- (cadr p0) 0.001)))
(list en2 p00)
) (command "fillet"
(list en1 (list (car tp1) (- (cadr tp1) 0.001)))
(list en2 tp2)
)
(princ) ) 谢谢！另外有删除中间被取剖面线的圆的办法吗？

meflying

好象我说的话你几乎没有听进去啊。。。


1、我让给一组输入数据，没有


2、已经给过你提示：取点可以(setq pt2 (cdr (assoc 11 le)))，视而不见，还是老法子。


3、command命令后面的参数是根据其命令需要来输入，而不是想输入什么就输入什么，(command "pline" p0 "a" p1 "") 这里p0处应该是输入点，可你的p0来源：(setq p0 (entget ff))，是一组DXF组码列表，完全不同，，，


4、让你先将基础部分熟悉了再写稍微复杂点的程序，你的程序问题百出，这样的程序是没法看的，要修改比根据要求重写一个的工程还要大。。。


是应该不怕困难，敢于挑战，有强烈的学习欲望是好的，不过也应该注意方法，还要有细心的习惯

linear

它不要输入什么呀，只要点两点(internal point ,base point)，就好了。


0：)真的是不细心哦。发现了。


我也猜po 可能取得方法不对，可不知道用什么方法是对的。提示一下吧。谢谢。

meflying

internal point ,base point分别是哪儿？


用法？我说了很多次了，command后的命令该让你输入什么参数你就输入什么参数，还不明白？而且我在14楼也已经点名了，在这里该输入点，而你的p0不是点，你必须找一个是点的变量来输入。。。。UNDERSTAND？


关于这个程序的问题我不会再作答了。。。你可以说你想做什么，我给你写一个，你参考一下。。。还是老话，先学好基础

linear

ok,我想做的是：取物体上的一个面，画剖面线，取每条线的长，再代入方程放大，你可以任意定义一个方程。再根据得到的新线长，算出线两端端点的坐标值。得到新的点，然后画曲线，再连接左右两个曲线。得到新的面的轮廓线。


so nice.

linear

hi,我已经在看书了，正在学Visual lisp函数详解，你不是答应我写一个参考程序的吗，忘记啦。我还是希望自己能最终写好程序的，还能象你一样在论坛上帮助别人。只是我现在还需要别人的提示呢。有时候自己的问题想半天也不知道错在哪里，别人提示一下就茅塞顿开了。谢谢。

meflying

FUN是放大方程

2. (defun fun(x)
3.    (* 2 x)
4. )(defun c:Scale_circle( / ent ents pt ss i pt1 pt2 ptCenter pt_lst)
5.    (setq os (getvar "osmode"))
6.    (setvar "cmdecho" 0)
7.    (setvar "osmode" 0)
8.    (setq ent (car (entsel "选择圆...")))
9.    (setq ents (entget ent))
10.    (setq pt (cdr (assoc 10 ents)))
11.    (command "_.bhatch" "a" "b" "n" ent "" "" "p" "u" "45" "10" "" pt "")
12.    (command "_.explode" (entlast))
13.    (setq ss (ssget "p"))
14.    (entdel ent)
15.    (setq i 0)
16.    (setq pt_lst nil)
17.    (repeat (sslength ss)
18.        (setq ent (ssname ss i))
19.        (setq ents (entget ent))
20.        (setq pt1 (cdr (assoc 10 ents)))
21.        (setq pt2 (cdr (assoc 11 ents)))
22.        (setq ptcenter (list (/ (+ (car pt1) (car pt2)) 2.0)
23.        (/ (+ (cadr pt1) (cadr pt2)) 2.0)
24.        (/ (+ (last pt1) (last pt2)) 2.0)
25.          )
26.        )
27.        (command "_.scale" ent "" ptCenter (fun 1))
28.        (setq ents (entget ent))
29.        (setq pt1 (cdr (assoc 10 ents)))
30.        (setq pt2 (cdr (assoc 11 ents)))
31.        (setq pt_lst (append pt_lst (list (list pt1 pt2))))
32.        (entdel ent)
33.        (setq i (1+ i))
34.    )
35.    (command "_.spline")
36.    (mapcar '(lambda (e) (command (car e))) pt_lst)
37.    (mapcar '(lambda (e) (command (cadr e))) (reverse pt_lst))
38.    (command "c" "")
39.    (setvar "osmode" os)
40.    (princ)
41. )

(defun fun(x)    (* 2 x) )(defun c:Scale_circle( / ent ents pt ss i pt1 pt2 ptCenter pt_lst)    (setq os (getvar "osmode"))    (setvar "cmdecho" 0)    (setvar "osmode" 0)    (setq ent (car (entsel "选择圆...")))    (setq ents (entget ent))    (setq pt (cdr (assoc 10 ents)))    (command "_.bhatch" "a" "b" "n" ent "" "" "p" "u" "45" "10" "" pt "")    (command "_.explode" (entlast))    (setq ss (ssget "p"))    (entdel ent)    (setq i 0)    (setq pt_lst nil)    (repeat (sslength ss)        (setq ent (ssname ss i))        (setq ents (entget ent))        (setq pt1 (cdr (assoc 10 ents)))        (setq pt2 (cdr (assoc 11 ents)))        (setq ptcenter (list (/ (+ (car pt1) (car pt2)) 2.0)        (/ (+ (cadr pt1) (cadr pt2)) 2.0)        (/ (+ (last pt1) (last pt2)) 2.0)          )        )        (command "_.scale" ent "" ptCenter (fun 1))        (setq ents (entget ent))        (setq pt1 (cdr (assoc 10 ents)))        (setq pt2 (cdr (assoc 11 ents)))        (setq pt_lst (append pt_lst (list (list pt1 pt2))))        (entdel ent)        (setq i (1+ i))    )    (command "_.spline")    (mapcar '(lambda (e) (command (car e))) pt_lst)    (mapcar '(lambda (e) (command (cadr e))) (reverse pt_lst))    (command "c" "")    (setvar "osmode" os)    (princ) )

linear

真的好酷阿。上面程序的后几步真是太妙了。一，spline 比 pline好，直接操作圆弧。二，直接将两个列表里的点首尾相连，省掉了fillet那一步。(我也正想着可不可以用reverse把一个列表倒过来，但发现reverse 是对列表的，而非选择集的，这里在上步没有把新点放到选择集里，而是每次生成后，直接补充到一个新表里，真的简便好多)


我把自己的程序改了一下，一下子就出来了一个新的类似椭圆的圆弧，真的好高兴阿。“翻身农奴把歌唱，吧扎嘿！”


谢谢你。