是否有编号命令i

vector · 发表于 2022-7-6 14:49:00

大家好！！！我想知道AutoCAD（2007）中是否有这样的命令？一种命令，每次单击对象时创建倾斜编号。该命令会添加新编号，下一个新编号比当前编号高1（+1），并提示用户为序列中的第一个编号赋值。提前非常感谢GM

wannabe · 发表于 2022-7-6 14:54:19

Vector，你也是MicroStation用户吗？

Lee Mac · 发表于 2022-7-6 14:57:39

很无聊，所以让你做这个


;; ============ Num.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text upon mouse click, with optional
;;  prefix and suffix.
;;
;;  SYNTAX: num
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;  VERSION:
;;  1.0  ~  05.04.2009
;;
;; ====================================
(defun c:num  (/ vlst ovar stmp intmp ptmp sutmp vars pt)
 (setq    vlst   '("OSMODE" "CLAYER")
   ovar   (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)
 (or (tblsearch "LAYER" "NumText")
     (vla-add (vla-get-layers
        (vla-get-ActiveDocument
          (vlax-get-acad-object)))
          "NumText"))
 (or sNum (setq sNum 1))
 (or inNum (setq inNum 1))
 (or Pref (setq Pref ""))
 (or Suff (setq Suff ""))
 (setq    stmp (getreal (strcat "\nSpecify Starting Number <" (rtos sNum) ">: "))
   intmp(getreal (strcat "\nSpecify Increment <" (rtos inNum) ">: "))
   ptmp (getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
   sutmp(getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: ")))
 (or (not stmp) (setq sNum stmp))
 (or (not intmp) (setq inNum intmp))
 (or (eq "" ptmp) (setq Pref ptmp))
 (or (eq "" sutmp) (setq Suff sutmp))
 (while (setq pt (getpoint "\nClick for Text... "))
   (Make_Text pt (strcat Pref (rtos sNum) Suff))
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (princ))
(defun Make_Text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
        '(8 . "NumText")
        (cons 10 txt_pt)
        (cons 40 (max 2.5 (getvar "TEXTSIZE")))
        (cons 1 txt_val)
        '(50 . 0.0)
        (cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)
        (cons 11 txt_pt))))

mdbdesign · 发表于 2022-7-6 14:59:18

文本看起来像：pref 1“后缀”马克是你计划实现的目标？

Lee Mac · 发表于 2022-7-6 15:02:43

你在查询我的代码Mdb吗如果是这样，是的，我认为用户可能需要前缀和/或后缀，例如

A10CB
A11CB
等等等等

我写得很快，很容易修改

mdbdesign · 发表于 2022-7-6 15:07:23

前缀和后缀可以。“Just”标记看起来像：1英寸，2英寸。（A10“CB；A11”CB）

Lee Mac · 发表于 2022-7-6 15:09:00

六羟甲基三聚氰胺六甲醚。。。不应该有任何引号-将对此进行调查..：P

Tankman · 发表于 2022-7-6 15:12:27

您可能喜欢标注。lsp。

一个简单的程序，经过多次更改以满足最终用户的需求。
标注。lsp

Lee Mac · 发表于 2022-7-6 15:17:32

我认为引号是因为您的单位设置为英制而不是公制，但这应该适合您

copy


;; ============ Num.lsp ===============
;;
;;  FUNCTION:
;;  Will sequentially place numerical
;;  text upon mouse click, with optional
;;  prefix and suffix.
;;
;;  SYNTAX: num
;;
;;  AUTHOR:
;;  Copyright (c) 2009, Lee McDonnell
;;  (Contact Lee Mac, CADTutor.net)
;;
;;  PLATFORMS:
;;  No Restrictions,
;;  only tested in ACAD 2004.
;;
;;  VERSION:
;;  1.0  ~  05.04.2009
;;
;; ====================================
(defun c:num  (/ vlst ovar dVars tmpVars pt)
 (setq    vlst '("OSMODE" "CLAYER")
   ovar (mapcar 'getvar vlst))
 (setvar "OSMODE" 0)
 (or (tblsearch "LAYER" "NumText")
     (vla-put-color
   (vla-add
     (vla-get-layers
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) "NumText") acYellow))
 (setq dVars '(sNum inNum Pref Suff))
 (mapcar '(lambda (x y) (or (boundp x) (set x y))) dVars '(1 1 "" ""))
 (setq tmpVars (list (getreal (strcat "\nSpecify Starting Number <" (rtos sNum 2 2) ">: "))
             (getreal (strcat "\nSpecify Increment <" (rtos inNum 2 2) ">: "))
             (getstring (strcat "\nSpecify Prefix <" (if (eq "" Pref) "-None-" Pref) ">: "))
             (getstring (strcat "\nSpecify Suffix <" (if (eq "" Suff) "-None-" Suff) ">: "))))
 (mapcar '(lambda (x y) (or (or (not x) (eq "" x)) (set y x))) tmpVars dVars)
 (while (setq pt (getpoint "\nClick for Text... "))
   (Make_Text pt (strcat Pref (rtos sNum 2 2) Suff))
   (setq sNum (+ sNum inNum)))
 (mapcar 'setvar vlst ovar)
 (princ))
(defun Make_Text  (txt_pt txt_val)
 (entmake (list '(0 . "TEXT")
        '(8 . "NumText")
        (cons 10 txt_pt)
        (cons 40 (max 2.5 (getvar "TEXTSIZE")))
        (cons 1 txt_val)
        '(50 . 0.0)
        (cons 7 (getvar "TEXTSTYLE"))
        '(71 . 0)
        '(72 . 1)
        '(73 . 2)
        (cons 11 txt_pt))))

Cad64 · 发表于 2022-7-6 15:20:29

我认为是时候将此线程移到lisp部分了眨眼：

[编程交流] 是否有编号命令i

发表回复

精选推荐