[求助]求此程序的代码or所用函数or编程方法or fas、VLX程序？谢谢。

ZZXXQQ

1、用entget函数选取图线；
2、在grread函数循环中使用entget中的点作为上一点，动态的用grdraw函数将鼠标当前点画线；同时根据两点的距离动态更改线条的线性比例。

jxlsp

fl202发表于2009-9-1 15:13:00其实这样的用途更大，这个没有规范要求是多少，具体倍数放大的话要试好几次才能得到比较满意的效果。而用这个程序一次即可得到满意的效果。

你这只是视觉上的效果,而图是要打印出来用的,规范有严格要求实部多长,虚部多长,所以只有输入放大倍数才能满足要求.

贱人

有意思，仿制一下:)

2. ;;动态调节线性比例,仿制userzhl的程序
3. ;;加入对比例为0和1时的判断，防止因1时无组码48，0时总是无法获得正确比例的容错处理
4. ;;贱人20090902
5. (defun c:aa( /  ss ssn en e48  pt1 dist M new48 ViewDist i newen Y-get-eyeshot )
6. (defun Y-get-eyeshot (/ )  ;$orr)  
7.   (setq rt    '()
8. ptctr (getvar "viewctr")
9. vph   (getvar "viewsize")
10. vps   (getvar "screensize")
11. ratio (/ (car vps) (cadr vps))
12. vpw   (* ratio vph)
13.   )
14.   (setq ptlb
15.   (list
16.     (- (car ptctr) (/ vpw 2))
17.     (- (cadr ptctr) (/ vph 2))
18.   )
19.   )
20.   (setq ptrt
21.   (list
22.     (+ (car ptctr) (/ vpw 2))
23.     (+ (cadr ptctr) (/ vph 2))
24.   )
25.   )
26.   (setq rt (list ptlb ptrt))
27. )
29. ;---
30.   (setq ss (ssget ":s:e" '((0 . "Arc,Circle,Line,LWPOLYLINE"))))
31.   (if ss
32.     (progn
33.       (setq ssn (ssname ss 0)
34.              en  (entget ssn)
35.       )
36.       (if (not (setq e48 (cdr (assoc 48 en))))
37.         (progn
38.           (setq e48 1
39.              newen (list (car en))
40.              en (cdr en)
41.              i     0
42.           )
43.   
44.           (repeat 8
45.             (setq newen (cons (car en) newen)
46.                  en  (cdr en)
47.                   i  (+ i 1)
48.             )
49.           )
50.           (setq newen (cons (cons 48 1) newen)
51.              newen (reverse newen)
52.                 en (append newen en)
53.              newen nil
54.           )
55.         )
56.       )
57.       (setq pt1 (getpoint "\n指定点："))
58.       (if pt1
59.         (while (/= (car (setq M (grread T 5 0))) 3)
60.           (setq dist (distance pt1 (cadr M))
61.                 ViewDist (distance (car (Y-get-eyeshot)) (cadr (Y-get-eyeshot)))
62.           )
63.           (if (= dist 0)
64.             (setq dist 0.01)
65.           )
66.           (if (= e48 0)
67.             (setq new48 (* (/ dist ViewDist) 100 0.1 1))
68.             (setq new48 (* (/ dist ViewDist) 100 0.1 e48))
69.           )
70.           (entmod (subst (cons 48 new48) (cons 48 e48) en ))
71.         )
72.       )
73.     )
74.   )
75. (princ)
76. )

;;动态调节线性比例,仿制userzhl的程序 ;;加入对比例为0和1时的判断，防止因1时无组码48，0时总是无法获得正确比例的容错处理 ;;贱人20090902 (defun c:aa( /  ss ssn en e48  pt1 dist M new48 ViewDist i newen Y-get-eyeshot ) (defun Y-get-eyeshot (/ )  ;$orr)     (setq rt    '() ptctr (getvar "viewctr") vph   (getvar "viewsize") vps   (getvar "screensize") ratio (/ (car vps) (cadr vps)) vpw   (* ratio vph)   )   (setq ptlb   (list     (- (car ptctr) (/ vpw 2))     (- (cadr ptctr) (/ vph 2))   )   )   (setq ptrt   (list     (+ (car ptctr) (/ vpw 2))     (+ (cadr ptctr) (/ vph 2))   )   )   (setq rt (list ptlb ptrt)) ) ;---   (setq ss (ssget ":s:e" '((0 . "Arc,Circle,Line,LWPOLYLINE"))))   (if ss     (progn       (setq ssn (ssname ss 0)              en  (entget ssn)       )       (if (not (setq e48 (cdr (assoc 48 en))))         (progn           (setq e48 1              newen (list (car en))              en (cdr en)              i     0           )              (repeat 8             (setq newen (cons (car en) newen)                  en  (cdr en)                   i  (+ i 1)             )           )           (setq newen (cons (cons 48 1) newen)              newen (reverse newen)                 en (append newen en)              newen nil           )         )       )       (setq pt1 (getpoint "\n指定点："))       (if pt1         (while (/= (car (setq M (grread T 5 0))) 3)           (setq dist (distance pt1 (cadr M))                 ViewDist (distance (car (Y-get-eyeshot)) (cadr (Y-get-eyeshot)))           )           (if (= dist 0)             (setq dist 0.01)           )           (if (= e48 0)             (setq new48 (* (/ dist ViewDist) 100 0.1 1))             (setq new48 (* (/ dist ViewDist) 100 0.1 e48))           )           (entmod (subst (cons 48 new48) (cons 48 e48) en ))         )       )     )   ) (princ) )

AMTONNY

(command "change" p1 "" "p" "color" "252" "ltype"( "DASHED2"此处为线型)

  (if (<= hh 0.7 )此数据为线长,楼主自已改吧

AMTONNY

再来一个自动的

5061220

学习动态修改

lijiao

(getpoint (getpoint))

AMTONNY

呵呵,宝贝已经被锁住了,应该要好好地反省下自已的言行哦,光说不练,连个小程序也要人家加他QQ收费,如何还打出一个:取之于明,用之于明哦.

jxlsp

贱人发表于2009-9-2 0:47:00有意思，仿制一下:);;动态调节线性比例,仿制userzhl的程序;;加入对比例为0和1时的判断，防止因1时无组码48，0时总是无法获得正确比例的容错处理;;贱人20090902(defun c:aa( /  ss ssn en

帮你加了根檬皮线.

fl202

jxlsp发表于2009-9-1 20:15:00你这只是视觉上的效果,而图是要打印出来用的,规范有严格要求实部多长,虚部多长,所以只有输入放大倍数才能满足要求.

请问是哪个规范规定的？标准号是多少？

我是做化工设计的，这个专业的规范上好像没有这方面的规定。同时感谢楼上几位给的程序和思路，谢谢！