找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1633|回复: 24

(完成)[编程申请]:修改图块的比例

[复制链接]
发表于 2003-6-30 18:57:15 | 显示全部楼层 |阅读模式

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

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

×
图中某图块(如:树)比例不同,有大有小,有无可能将某一比例的图块改为另一比例???
谢谢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-6-30 19:10:54 | 显示全部楼层

Re: [编程申请]:修改图块的比例

  1. ;;;------修改一种块比例-----
  2. (defun c:gkbl(/ ent km bl xx n entname entlist)
  3.    (setvar "cmdecho" 0)
  4.    (setq ent (assoc 2 (entget (car (entsel "\n请选择要修改比例的一种块:"))))
  5.          km  (cdr ent)
  6.          bl (getreal "\n请输入比例:")
  7.    )
  8.    (setq xx (ssget "x" (list (cons 2 km)))
  9.          n  (1- (sslength xx))
  10.    )
  11.    (repeat (sslength xx)
  12.       (setq entname (ssname xx n)
  13.             entlist (entget entname)
  14.             entlist (subst (cons 41 bl)(assoc 41 entlist) entlist)
  15.             entlist (subst (cons 42 bl)(assoc 42 entlist) entlist)
  16.             entlist (subst (cons 43 bl)(assoc 43 entlist) entlist)
  17.        )
  18.        (entmod entlist)
  19.        (setq n (1- n))
  20.    )(princ)
  21. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-6-30 20:46:50 | 显示全部楼层
谢谢小狼.
我希望只修改特定比例的图块. 如: 同一棵树,有5倍大的,有7倍大的,我想把5倍的变为3倍大,而7倍大的树不变.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 593个

财富等级: 财运亨通

发表于 2003-6-30 21:55:10 | 显示全部楼层
最初由 kfboyxwa 发布
[B]谢谢小狼.
我希望只修改特定比例的图块. 如: 同一棵树,有5倍大的,有7倍大的,我想把5倍的变为3倍大,而7倍大的树不变. [/B]
  1. (defun c:test (/ e ss scl)
  2.   (xdrx_begin)
  3.   (setq e (xdrx_entsel "\n选择典型图块: " '((0 . "insert"))))
  4.   (if e
  5.     (progn
  6.       (xdrx_setenttodb (car e))
  7.       (princ (strcat "\n所选图块为[ "
  8.                      (xdrx_getentdxf 2)
  9.                      " ], 比例 = "
  10.                      (rtos (xdrx_getentdxf 41) 2 3)
  11.              )
  12.       )
  13.       (setq scl (getreal "\n新比例: "))
  14.       (princ "\n拾取范围...")
  15.       (setq ss (ssget (list (cons 2 (xdrx_getentdxf 2))
  16.                             (cons 41 (xdrx_getentdxf 41))
  17.                       )
  18.                )
  19.       )
  20.       (xdrx_setsstodb ss 0)
  21.       (while (xdrx_getentdata 0)
  22.         (xdrx_modent 41 scl 42 scl 43 scl)
  23.       )
  24.     )
  25.   )
  26.   (xdrx_end)
  27.   (princ)
  28. )

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-1 12:07:56 | 显示全部楼层
;;;------修改选择的块比例-----
(defun c:gk(/ ent km bl xx n entname entlist)
   (setvar "cmdecho" 0)
   (setq bl (getreal "\n请输入比例:")
   )
   (princ "\n请选择要修改的块")
   (setq xx (ssget (list (cons 0 "INSERT")))
         n  (1- (sslength xx))
   )
   (repeat (sslength xx)
      (setq entname (ssname xx n)
            entlist (entget entname)
            entlist (subst (cons 41 bl)(assoc 41 entlist) entlist)
            entlist (subst (cons 42 bl)(assoc 42 entlist) entlist)
            entlist (subst (cons 43 bl)(assoc 43 entlist) entlist)
       )
       (entmod entlist)
       (setq n (1- n))
   )(princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-1 12:36:48 | 显示全部楼层
试试这个:
(defun c:test ()
  (vl-load-com)
  (setq obj (car (entsel "Select Block:")))
  (setq sf (getreal "\nInput Scale Factor:"))
  (setq obj (vlax-ename->vla-object obj))
  (vlax-put-property obj 'XScaleFactor sf)
  (vlax-put-property obj 'yScaleFactor sf)
  (vlax-put-property obj 'zScaleFactor sf)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-7-1 13:52:20 | 显示全部楼层
谢谢各位!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-1 16:18:48 | 显示全部楼层
直接用scale不行吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 488个

财富等级: 日进斗金

发表于 2003-7-1 22:06:21 | 显示全部楼层
还是scale好,如果考虑有属性的情况.

  1. (defun c:test( / obj ent sf)
  2. (setq obj (car (entsel "Select Block:"))
  3.           ent(entget obj))
  4. (setq sf (getreal "\nInput Scale Factor:"))
  5. (setq sca(/ sf (cdr(assoc 41 ent))))
  6. (command".scale" obj ""(cdr(assoc 10 ent)) sca)
  7. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-10 22:01:14 | 显示全部楼层
我觉的还是用SCALE好,不是图块也能变
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-7-13 17:51:13 | 显示全部楼层
scale能实现同时变多个图块的比例(以每个图块的原插入点为变比例中心?)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-14 00:45:17 | 显示全部楼层
我的收藏,还未测试,不知能不能用:)

  1. ;block edit; N改块/X左右镜相/Y前后镜相/V新尺寸/S放缩/XX改x值/YY改y值   -V2.0-----lxx.2002.10
  2. ;dwall can be stretch at the same time when V
  3. (defun chb1 ( )
  4.   (initget "N X Y V S XX YY")
  5.   (setq kw (strcase(getkword "\nN改块/X左右镜相/Y前后镜相/V新尺寸/S放缩/XX改x值/YY改y值:")))
  6.   (cond ((= "N" kw) (setq cod 2 nval (strcase (getstring "\n new block name:"))))
  7.         ((= "X" kw) (setq cod 41))
  8.         ((= "Y" kw) (setq cod 42))
  9.         ((= "XX" kw) (setq cod 41)(setq nval (getdist "\n新的x值:")))
  10.         ((= "YY" kw) (setq cod 42)(setq nval (getdist "\n新的y值:")))
  11.         ((= "V" kw) (setq cod 41 nvl (getdist "\n new insert-scale value:")))
  12.         ((= "S" kw) (setq cod 41 sc (getdist "\n scale:")))
  13. )  )

  14. (defun chb2 (/ oe nent ipt ang pt1 pt2 p1 p2)
  15.   (setq oe (assoc cod ent) val (cdr oe))
  16.   (cond
  17.         ((= "N" kw)(princ "\nOK!"))
  18.         ((= "X" kw)(setq nval (- 0 VAL)))
  19.         ((= "Y" kw)(setq nval (- 0 VAL)))
  20.         ((= "XX" kw))
  21.         ((= "YY" kw))
  22.         ((= "V" kw)(setq nval (/ (* val nvl) (abs val))
  23.                          ipt (cdr (assoc 10 ent)) ang (cdr (assoc 50 ent)))
  24.                    (COMMAND "UCS" "")             ;MUST LINE
  25.                    (setvar "osmode" 0)
  26.                    (setq pt1 (polar ipt ang val) anp (/ pi 20)
  27.                          pt2 (polar ipt ang nval)
  28.                          p1 (polar pt1 (+ (+ ang (/ pi 2)) anp) 200)
  29.                          p2 (polar pt1 (+ (- ang (/ pi 2)) anp) 200)))
  30.         ((= "S" kw)(setq nval (* sc VAL)))
  31.   )     
  32.   (setq nent (subst (cons cod nval) oe ent)) (entmod nent)
  33.   (if (or (= "V" kw) (= "S" kw))                                     ;y value
  34.       (if(/= "C" (cdr (assoc 2 ent)))
  35.       (progn  (setq oe (assoc 42 nent) val (cdr oe))
  36.         (if(= "V" kw)(setq nval (/ (* val nvl) (abs val))))
  37.         (if(= "S" kw)(setq nval (* sc VAL)))
  38.         (setq nent (subst (cons 42 nval) oe nent))
  39.         (entmod nent)
  40.   )   ))
  41.   (if (= "V" kw)
  42.       (command "_stretch" "c" p1 p2 "" pt1 pt2)  
  43. ) )
  44. ;;main
  45. (defun c:chb (/ ss n i kw nvl sc)
  46. ;  (COMMAND "UCS" "" "PLAN" "")
  47.   (chb1) (setvar "osmode" 0)
  48.   (setq ss(ssget)
  49.         n (sslength ss)
  50.         i 0)
  51.   (repeat n
  52.     (setq ent (entget (ssname ss i) '("*")) i (+ 1 i))
  53.     (if (or (= "INSERT" (cdr (assoc 0 ent)))
  54.             (= "ATTRIB" (cdr (assoc 0 ent)))) (chb2))
  55.   )(princ)
  56. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-14 11:25:27 | 显示全部楼层
楼上的程序和CAD里自身带的没什么区别啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-7-25 09:59:43 | 显示全部楼层
能能不编写一个可以将块属性一起缩放的程序。
这样一些自定义的如标高符号 或 轴号 就可以一起缩放了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-8-2 03:55:45 | 显示全部楼层
最初由 chenhang1203 发布
[B]楼上的程序和CAD里自身带的没什么区别啊 [/B]


最好下次能做个演示
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-5-3 00:12 , Processed in 0.325430 second(s), 60 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表