社区 › Auto Lisp › 更改此李的属性

Nellie 发表于 2022-7-6 17:24:42

更改此李的属性

你好，
 
有人能帮我一下吗，我一直在尝试更改我使用的一个有用的lisp的属性。
 
每次拾取点时，lisp都会给我一个级别值，但我想更改线型和点标记。
 
有人知道如何改变这一点吗？
 
提前谢谢。
 
内利。
 
下面是Lisp。
 

(defun c:txm()
(terpri)
;; Perform math on text numbers in-place, by Carl B., coded March 2000
(setvar "cmdecho" 0)
;; select lines to annotate
(setq mfactor 1 afactor 0 input nil)
(initget "M A")
(setq input (getkword "\nMultiply<M> or Add<A>?: "))
(cond
((= input "M") (initget 1)
(setq mfactor (getreal "\nMult Factor: ")))
((= input "A") (initget 1)
(setq afactor (getreal "\nAdd Amount: ")))
(T nil)
) ; cond
(initget 1)
(setq precis (getint "\nPlaces after decimal: "))
(setq units (getstring T "\nEnter units to append: "))
(princ "\nSelect text to revise: ")
(setq textset nil)
(while (not textset) (setq textset (ssget '((0 . "*TEXT")))))
(setq numitems (sslength textset))
;; loop to isolate text & change text
(setq itemno 0)
(repeat numitems
(setq entname (ssname textset itemno))
;;(setq enttype (cdr (assoc 0 (entget entname))))
(setq oldtxt_pr (assoc 1 (entget entname)))
(setq oldtxt (cdr oldtxt_pr))
(setq oldtext# (atof oldtxt))
(setq newtext# (+ (* oldtext# mfactor) afactor))
(setq newtxt (strcat (rtos newtext# 2 precis) units))
(setq newtxt_pr (cons 1 newtxt))
(setq entstuff (entget entname))
(setq entstuff (subst newtxt_pr oldtxt_pr entstuff))
(entmod entstuff)
(setq itemno (1+ itemno))
) ; repeat
(princ)
) ; the end
(princ "Do math on text Start with \"TXM\"")
(princ)

ASMI 发表于 2022-7-6 17:36:37

 
你确定这个Lisp程序有效吗？

Nellie 发表于 2022-7-6 17:40:47

它适用于我的机器和2008，但我只需要更改文本样式和点标记。
 
你能帮忙吗？
 
当做

ASMI 发表于 2022-7-6 17:46:25

如果你详细说明你的要求，我可以帮你。。。我只需要更改文本样式和点标记这里没有足够的信息来制作一些东西。

Lee Mac 发表于 2022-7-6 17:49:57

内莉，
 
如果我理解正确，（如果我错了，请纠正我），但您使用的LISP是一个程序，它将对包含数字的文本执行一些数学运算。
 
当你说
 
 
你的意思是改变文字风格吗？

Nellie 发表于 2022-7-6 17:59:32

大家好，
 
对不起，没有给大家提供正确的信息。
 
这个lisp现在正在创建高度为0.2的标准Courier New级别（文本样式），但我希望它的高度为0.18的标准Simple。
 
我还希望目前正在创建的箭头被一个0.18大小的十字（+）替换。
 
再次提前感谢。
 
内莉

ASMI 发表于 2022-7-6 18:06:16

 
它是另一个lisp而不是C:TXM。你能用你的水平标记发布lisp或screenshort图片吗？

Nellie 发表于 2022-7-6 18:07:21

现在应该附加lisp。
 
谢谢
倒转lsp

Lee Mac 发表于 2022-7-6 18:14:01

试试这个，如果你有任何问题，请告诉我
指针。lsp

ASMI 发表于 2022-7-6 18:21:33

 
你是说单纯形吗。shx字体？
 
试试这个。它使用属性级别和交叉标记创建块，并自动添加“单纯形”样式。
 
(defun c:lemar(/ sCol bCol nStl nBlk
          cBlk nAtr ln1 ln2 cAtr)

(vl-load-com)

(setq aDoc(vla-get-ActiveDocument
      (vlax-get-acad-object))
   sCol(vla-get-TextStyles aDoc)
   bCol(vla-get-Blocks aDoc)
   ); end setq
(if(vl-catch-all-error-p(vl-catch-all-apply 'vla-Item
(list sCol "Simplex")))
    (progn
      (setq nStl(vla-Add sCol "Simplex"))
      (vla-put-FontFile nStl "simplex.shx")
   ); end progn
   ); end if
(if(vl-catch-all-error-p(vl-catch-all-apply 'vla-Item
(list bCol "Level Marker")))
   (progn
   (setq nBlk(vla-Add bCol
             (vlax-3D-point '(0 0 0))
             "Level Marker"))
   (setq nAtr(vla-AddAttribute nBlk 0.18 acAttributeModePreset
                     "" (vlax-3D-point '(0 0 0)) "LEVEL" "X"))
   (vla-put-Alignment nAtr acAlignmentBottomCenter)
   (vla-put-StyleName nAtr "Simplex")
   (vla-put-TextAlignmentPoint nAtr
   (vlax-3D-point '(0.0 0.1 0.0)))
   (setq ln1(vla-AddLine nBlk(vlax-3D-Point '(-0.09 0.0 0.0))
                  (vlax-3D-Point '(0.09 0.0 0.0)))
         ln2(vla-AddLine nBlk(vlax-3D-Point '(0.0 -0.09 0.0))
                  (vlax-3D-Point '(0.0 0.09 0.0))))
   (mapcar 'vla-put-Layer '(nAtr ln1 ln2) '("0" "0" "0"))
    ); end progn
   ); end if
(princ "\nPlace level marker or Right Click to Quit> ")
(while(setq cPt(getpoint))
   (setq cBlk(vla-InsertBlock(vla-get-ModelSpace aDoc)
        (vlax-3D-Point cPt)"Level Marker"
       1.0 1.0 1.0 0.0)
cAtr(car(vlax-safearray->list
       (vlax-variant-value(vla-GetAttributes cBlk)))))
   (vla-put-TextString cAtr(rtos(cadr cPt)2 2))
   ); end while
(princ)
); end of c:lemar

查看完整版本: 更改此李的属性