改线型比例的代码，高手帮我看看

lucas3 · 发表于 2014-1-5 23:55:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 lucas3 于 2014-1-7 16:21 编辑

已经搞定了，感谢在此回贴的每一次朋友！有了你们晓东更精采！

zxq0220 · 发表于 2014-1-6 08:10:26

本帖最后由 zxq0220 于 2014-1-7 07:56 编辑

(defun c:tt (/ ss l n e nl show)
(if (setq ss (ssget '((0 . "*LINE")))) (progn
(setq nl (cdr(assoc 48 (entget(ssname ss 0)))))
(setq n (sslength ss))
(while (> n 0)
(setq l (cdr(assoc 48 (entget (ssname ss (setq n (1- n)))))))
(if (not(equal nl l 0.001)) (setq n -2))
)
(setq show (if (= n -2) "多种" (rtos nl 2)))
(setq l (if (setq l (getdist (strcat "\n 请输入新的线型比例<" show "> :"))) l nl))
(repeat (setq n (sslength ss))
(setq e (entget (ssname ss (setq n (1- n)))))
(entmod (append e (list (cons 48 l))))
)
))
(princ)
)

lucas3 · 发表于 2014-1-6 09:24:34

zxq0220 发表于 2014-1-6 08:10

大师，完全运行不了啊

ysq101 · 发表于 2014-1-6 12:14:01

(defun c:tt ( / ss l n e a)
(setq ss (ssget))
;要达到你的要求，主要是以下两段
(setq a (cdr(assoc 48(entget(ssname ss 0)))))
(setq l (getdist (strcat "\n 请输入新的线型比例<" (rtos a 2 3) "> :")))
(repeat (setq n (sslength ss))
(setq e (entget (ssname ss (setq n (1- n)))))
(entmod (append e (list (cons 48 l))))
)
(princ)
)
;小测试了一下，，，其它的你自己修改你需要的

lucas3 · 发表于 2014-1-6 15:23:15

各位是不是误解我的意思呢？我的意思是当我选择线段时，要显示这段线当前的线型比例值，比如，没修改线型比例时是1.0，选择择这条线时应该提示“ 当前线段的线型比例是1.0，请输入新的线型比例： ” 此时如果我修改成0.5 ，那么下次再选择这条线时，就应该是“ 当前线段的线型比例是0.5，请输入新的线型比例： ”

st788796 · 发表于 2014-1-6 15:37:43

lucas3 发表于 2014-1-6 15:23
各位是不是误解我的意思呢？我的意思是当我选择线段时，要显示这段线当前的线型比例值，比如，没修改线型 ...

你说的单选可以，多选时这个比例可能不一样，这时按哪个提示都可能误导

lucas3 · 发表于 2014-1-6 15:46:34

st788796 发表于 2014-1-6 15:37
你说的单选可以，多选时这个比例可能不一样，这时按哪个提示都可能误导

那多选时如果一样，就可以提示，不一样时就显“*多种*” 这样做可以么？

st788796 · 发表于 2014-1-6 15:49:04

lucas3 发表于 2014-1-6 15:46
那多选时如果一样，就可以提示，不一样时就显“*多种*” 这样做可以么？

如果用lisp为了一句话遍历一次可能稍慢点

lucas3 · 发表于 2014-1-6 16:02:21

st788796 发表于 2014-1-6 15:49
如果用lisp为了一句话遍历一次可能稍慢点

慢了点无所谓，多选的情况不多，一般单选，你能帮忙改改吗，谢谢！

st788796 · 发表于 2014-1-6 16:29:26

lucas3 发表于 2014-1-6 16:02
慢了点无所谓，多选的情况不多，一般单选，你能帮忙改改吗，谢谢！

一般用Lisp + API写应用

lucas3 · 发表于 2014-1-6 16:31:28

st788796 发表于 2014-1-6 16:29
一般用Lisp + API写应用

这个简单的没必要上API吧

st788796 · 发表于 2014-1-6 17:14:04

lucas3 发表于 2014-1-6 16:31
这个简单的没必要上API吧

(defun c:tt ()
(if (and (setq ss (ssget ":L" '((0 . "*LINE"))))
(SETQ el (xdrx_pickset->ents ss))
(if (apply '= (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "ltscale")))))
.…
))
)
不用api就用ss->ents

zxq0220 · 发表于 2014-1-6 21:27:56

沙发改了，再试试。

lucas3 · 发表于 2014-1-6 21:56:07

zxq0220 发表于 2014-1-6 21:27
沙发改了，再试试。

大师，还是一样了，选择完对象后，空格键 --------什么都没有发生都结束了
QQ图片20140106215359.jpg

Free-Lancer · 发表于 2014-1-6 22:59:03

(defun c:tt (/ el str scl)
(fy:begin)
(if
(and
(ssget ":L" '((0 . "*LINE")))
(setq el (fy:cset->objs))
(if (apply '=
(mapcar '(lambda (x) (vlax-get x 'LinetypeScale)) el)
)
(setq
str (vl-princ-to-string (vlax-get (car el) 'LinetypeScale))
)
(setq str "多种")
)
(setq scl (getreal (strcat "\n输入比例<" str ">: ")))
)
(mapcar '(lambda (x)
(vlax-put x 'LinetypeScale scl)
)
el
)
)
(fy:end)
(princ)
)

账号		自动登录	找回密码
密码			立即注册

[求助] 改线型比例的代码，高手帮我看看

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评

点评

点评