设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 请教尺寸标注样式创建快捷办法
返回列表 发新帖
查看: 343|回复: 3

[求助] 请教尺寸标注样式创建快捷办法

[复制链接]
a117034423

已领礼包: 201个

财富等级: 日进斗金
发表于 2020-12-9 16:48:02 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
除Emake与vl外
还有没有更快的方法？论坛帖子有emake 没有vl的
如何创建最高效？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

WhoCanSay
发表于 2020-12-9 19:58:45 | 显示全部楼层
先看看你的Emake法。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

a117034423

已领礼包: 201个

财富等级: 日进斗金
 楼主| 发表于 2020-12-10 10:21:37 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  1. (entmake (list '(0 . "DIMSTYLE")
  2.                  '(100 . "AcDbSymbolTableRecord")
  3.                  '(100 . "AcDbDimStyleTableRecord")
  4.                  '(70 . 0)
  5.                  (cons 340 (tblobjname "style" "Standard")) ; 文字样式名
  6.                  (cons 2 "普通螺纹")   ; 标注样式名
  7.                  '(3 . "M<>")        ; 标注前缀
  8.                  '(40 . 0.0)        ; 标注特征比例，缩放到布局
  9.                 '(41 . 2.5)        ; 箭头尺寸
  10.                 '(42 . 1.5)        ; 起点偏移量
  11.                 '(43 . 5.5)        ; 基线间距
  12.                 '(44 . 1.5)        ; 超出尺寸线
  13.                 '(47 . 0.000)        ; 上偏差
  14.                 '(48 . 0.000)        ; 下偏差
  15.                 '(71 . 0)        ; 公差无
  16.                 '(77 . 1)        ; 文字在尺寸线上方
  17.                 '(74 . 1)        ;
  18.                 '(140 . 3.0)        ; 文字高度
  19.                 '(141 . -2.5)        ; 圆心标记
  20.                 '(144 . 1.0)        ; 测量比例单位
  21.                 '(146 . 0.7)        ; 公差高度比例
  22.                 '(147 . 1.0)        ; 文字从尺寸线偏移
  23.                 '(172 . 2)        ; 尺寸界线间连线
  24.                 '(176 . 256)        ; 随层
  25.                 '(177 . 256)        ; 随层
  26.                 '(178 . 256)        ; 随层
  27.                 '(271 . 3)        ; 尺寸标注精度
  28.                 '(272 . 3)        ; 公差标注精度
  29.                 '(275 . 0)        ; 角度标注制式，十进制。
  30.                 '(288 . 1)        ; 手动放置尺寸
  31.                  )
  32.   )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

WhoCanSay
发表于 2020-12-10 12:00:28 | 显示全部楼层
本帖最后由 WhoCanSay 于 2020-12-10 12:04 编辑

;;建立标注样式
(defun _BuildDDS (Lis DimS / DStyleSub CLRD I L LFAC NDIM ONAME STYLESTR)

  (defun DStyleSub (StyleNum colorNum)
    (setq StyleStr (strcat StyleNum "b1"))
    (if        (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list DimS StyleStr)))
      (setq NDim (vla-add DimS StyleStr))
      (progn
        (vla-delete (vla-item DimS StyleStr))
        (setq NDim (vla-add DimS StyleStr))
      )
    )
    (vla-copyfrom (vla-item DimS OName) NDim)
    (setvar "dimlfac" (/ 1.0 (distof StyleNum)))
    (setvar "DIMCLRD" colorNum)
    (vla-copyfrom NDim *DOC*)
    (vla-put-activedimstyle *DOC* NDim)
    ;;下面四句不恢复，则当有样式会发生变化
    (setvar "dimlfac" lfac)
    (setvar "DIMCLRD" CLRD)
    (vla-copyfrom (vla-item DimS OName) *DOC*)
    (vla-put-ActiveDimStyle *DOC* (vla-item DimS OName))
  )

  (setq lfac (getvar "dimlfac"))
  (setq CLRD (getvar "DIMCLRD"))
  (setq OName (getvar "dimstyle"))
  (setq i 0)
  (repeat (length Lis)
    (setq L (cons (setq i (1+ i)) L))
  )
  ;;(DStyleSub 放大倍数 颜色)
  (VL-CATCH-ALL-APPLY 'mapcar (list 'DStyleSub Lis L))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;标注样式
(VL-LOAD-COM)
(defun C:DDS (/ DIMS E I INDEX ISTR KWSTR S SMENU STR)
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (setq DimS (vla-get-DimStyles *DOC*))

  (initget "S ")
  (setq e (entsel "\n[尺寸样式为当前/建立标注样式(S)/标注样式选择]<标注样式选择>:"))
  (cond        ((= e "S")
         (cond ((setq str (getenv "DDS")))
               (T (setq str "2.5 4 10 16 25 40"))
         )
         (setq s (getstring T (strcat "\n新建<" str ">:")))
         (cond ((not (parse4 s " ,　，")) (setq s str)))
         (setenv "DDS" s)
         (_BuildDDS (parse4 s " ,　，") DimS)
        )
        ((= (type e) 'LIST)
         (cond ((setq s (getenv "DDS")))
               (T (setq s "2.5 4 10 16 25 40"))
         )
         (_BuildDDS (parse4 s " ,　，") DimS)

         (princ "\n现在尺寸标注样式为:")
         (setq e (car e))
         (princ (setq index (vla-get-StyleName (vlax-ename->vla-object e))))
         (vla-put-ActiveDimStyle *DOC* (vla-item DimS index))
        )
        (T
         (cond ((setq s (getenv "DDS")))
               (T (setq s "2.5 4 10 16 25 40"))
         )
         (_BuildDDS (parse4 s " ,　，") DimS)

         (setq i 65)
         (setq IStr "")
         (setq KWStr "\n 标注样式选择[")
         (repeat (vla-get-Count DimS)
           (setq IStr (strcat IStr (chr i) "  "))
           (setq KWStr
                  (strcat KWStr
                          (strcat (chr i)
                                  "("
                                  (vla-get-name
                                    (vlax-invoke-method
                                      DIMS
                                      'Item
                                      (- i 65)
                                    )
                                  )
                                  ")"
                                  "/"
                          )
                  )
           )
           (setq i (1+ i))
         )
         (setq KWStr (strcat (vl-string-right-trim "/" KWStr) "]" "<"))
         (setq KWStr
                (strcat        KWStr
                        (vla-get-name (vlax-invoke-method DIMS 'Item 0))
                        ">:"
                )
         )
         (setq smenu (getvar "shortcutmenu"))
         (setvar "shortcutmenu" 11)                            ;必须有这一句,右键回车时才能出现菜单选择项
         (initget IStr)
         (setq index (getkword KWStr))
         (setvar "shortcutmenu" smenu)
         (if (or (equal index nil) (equal index ""))
           (setq index 0)
           (setq index (- (ASCII index) 65))
         )
         (vla-put-ActiveDimStyle *DOC* (vla-item DimS index))
         (princ "\n现在尺寸标注样式为:")
         (princ (vla-get-name (vlax-invoke-method DimS 'Item index)))
        )
  )

  (Dim2DimLayer)                                            ;尺寸归入"DIM"层
  
  (princ)
)

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

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-4-26 22:57 , Processed in 0.357897 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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