论坛大佬的代码 求各位大佬帮我改下 把生成的文字变成匿名块 谢谢

qq787116960

论坛的代码  求大佬帮我改下  把生成的文字变成一个匿名块 谢谢


(defun c:沿线写字        (/    a1   a2        am   aml  an   box  cen         dir
                         DLEnt           e        e1   e2          from h    i         len
                         mat  n           p        p1   p2          pa   pl   pv         tf
                         tf1  to   tox        toy  toz  txt  pts  sub         pa1
                         pa2  m           m1
                        )
  (setq        TxtAtLine-ODCL-DATA
         '("YWt6Ay4vAAAjmNcJBuKTJJURKjtqgZMstFMSlz1gO2DofiTqvIjPLkpsy/5WuywWzJZk5Mhq1oof"
           "Bv3PWgDfOPO6bv2WAV5WWNyvcagW/Ia/ujH6cYS35uZWZHNPujmVR83FibDixbKT6CMky8XHxY3l"
           "RQmYkOKhkbLHGcgKGgZ6190e1hkWnvPoBlx6npUXvgqEmG01RS75q/bf/8AJrRlLFK530NM4Q8PF"
           "btssxCtLy/cvE9OE8C8TY8vxLPNkFvoF0tno4yrN9aCTlJSrqhFFi7pD0NvkoyoU3ixFw9XX+Wbr"
           "qS4DY+MR2Szy0NY9d1wCyU2GMC9/WfpOLFFk2AZDiC2dXRa7L2K6vQpK32UDSvKNSXQtcz0CJbAl"
           "fGFohk0yMx2ADsBvmfFmBj9ZkLmzOSH8GIQA8vAQ1JPYKEOKB+KR1U4aiIXZZpnWvvAWAWebl2c2"
           "M/vNc3uuILD3mjGeqXEacNmivRmGgvlgKJNRdIL/vpF1gulJYOEOMBwkZPGOBjVyXTPTem2Ry7AG"
           "vIcMqpjVjLjS2iz6880+v4fse/tlK0nDCiczuId3vQ+Rw6eVCW2dPN3VDq/XHRnil5yJi2cTXCXO"
           "Y+sKktt/BZYjNzqWv2BGscapW1eqUQ7RRQiWCeDZA5wC8b7s7JucoBkFBmGd02DAtsa7vUJ/sEz/"
           "4Y6OV7jl++PleqBcjp18XRqw5RcTRon2B6sSAuDwtmrOC4fLPKQGOFUzSO2ab2Lcsf2WWeSqGB2T"
           "VIbSI06iDxuFRNL9TSv2Uhz2Dm/1A3knx7PrwrCrSBLbLFmnXleFOFsIuCOag+J1POORd4LQboJF"
           "fOFphuK+gXzIKE4AI6LZuKCRH8yJf7hR96HXz+fpfRmmZSGLic3G4RWQQlrRgS/Oj2mRideIQccg"
           "Uvfp9JVLi5L+1+D57gmL6vH4AUj7O5f2jvKg155E1065LSZBA6mEO1/3VvdETR476/rv+uz67frq"
           "+pNunXN0YmnGNR43zkl7ACQeN9ZefHhvNGwOSXwpBKPJ02zI8HTSO38Bjgpoxpg24KkCHUkd9eEs"
           "k9n1jRsgAXTxqJECkvMF85HVP4rVh/Mntp5JkG2dFACaKeYAGmudazwZq3yhVbiBIh6zkepOIBKC"
           "sC5qsDTRu/NtjgVksw2OjNgF8JnvfbHPKKLPl0cYGIhn8SyjzSjxLzc5+gXk2Z40IaKrOiMKVo2o"
           "t1utkUOaTGmaM5pM6RERXMM/wKtg3hBnvWl2qBWUK8/hZ6cy91n4eMADWxUz8Su95Bg1H6mWW+Zk"
           "A3TYuBQfKa485nQEcEcu7iYVE/Q3Ue1Imw7SZx9EKlbGIlTZ1i8zV1GnkBTlW2FKhRH4QczzWcCk"
           "KcaTxWm5YmMkUmJqsyP4Fx9rU8t2+CZSYv0XnzCaX8TEJU6qGj73gffK8y5xpwFRz74YBYsaGES9"
           "h4KCHpFPne09jwGle9TL2yYfpaRsgjLh+9EieOEovFnFnPcSQhswCxqP6uLgrQtKWRqUlkmmC+r+"
           "19157w0xFyu8LIbqTmdoehf8AbMy+wMH0I45IxvTyeahLCPy67Xogu20WRci024ig+qxMZ6C7STd"
           "jLLbdplRNWrQjJvJ5BdfnjJPmcsG/0Y+Vtng0fuPuCpYQ6tjTZy+sNg/gABfAIPOzbdF0dCBPLIO"
           "YMKeDKbd90UeTNUmTjU7ZelC0kyuvdxB8wf1HkyRRgyFeuj/BzuVt96FK77pSM/z9WVmoZDLIVg1"
           "2qFVy1k5KhhX3A4uGFfmq0eyElYIG8XIofiyuCIaHsNbaC6nFTN7SWaZTs3fgoccn1HNthWaW10U"
           "sRWyzBs6JUu8p8oI/48a3A0ibeMUodkqH6HAMcaRlqc6aE9xofbyBzCR0kRqxnXt/eZWlsfGfdj4"
           "Qf/XvykfqaZP5mTFdQfx51zn4CTlfQhkKqir8oVVEIh6ogLNI823mXqFDXwV2DKfr5PrqDbtUjLk"
           "2lX9L2S334jvV+aU7bhn/f3FSwELG4UekTqOKZTBXOTBZPqX0eC6+o0pG7/6cIwi71yE5tMeSj2g"
           "yGHDmraFOWO1tCNIOboGS6CHI7bzI4eYAwij7vSwrZ0UCEBzrbBRTeCdQ3doW7ngLPXr9tcsY+vc"
           "EFcnKZGoq8ULT8kQyyUknehkKrdo69Rn9/eNGOrkZCnxK8canVsR/pXCYj6gB0dJRiijOpsQzJqg"
           "L5JTRgW4R1zDu9m7pewn4N3OU83ig9A1CMUOnwaclKePtlJ5k79j+teGDU4L2UK+hpC/e5AyMRjo"
           "zap6yeDVDo4AGojnuf6DtrNjKXnQYWBkZvGDtj1Op4BIMsjVg7t3ymHnH4NWS6nxiqSf51O1Y7cH"
           "hKHpg8PLg3EJXYeLceJ4NTs="
          )
  )
  (defun c:TxtAtLine_Ok#OnClicked (/)
    (setq #XDTB_GLOBALVAR_Txtbox
           (dcl-control-GetText XD_DrawAtLine_Txtbox)
          #DrawAtLine_Direction
           (dcl-Control-GetCurrentSelection Direction)
          #txtH        (dcl-Control-GetText XD_DrawAtLine_TxtHeight)
          txtH (* (xd::var:getdrawratio) (ATOF #TXTH))
          #DrawAtLine_DLineCheck
           (dcl-control-GetValue XD_DrawLineCheck)
          #DrawAtLine_explode
           (dcl-Control-GetValue TxtAtLine_Alpha)
          #DrawAtLine_Gap
           (dcl-Control-GetText DrawAtLine_Gap)
    )
    (setq TXTL NIL)
    (setq txtL (xdrx_string_regexps
                 (if (= 0 #DrawAtLine_explode)
                   "[\\u4E00-\\u9FA5]|[A-Za-z0-9]+"
                   "[\\u4E00-\\u9FA5]|[A-Za-z0-9]"
                 )
                 #XDTB_GLOBALVAR_Txtbox
               )
          len  (length txtL)
          tf1  nil
    )
    (if        (< (length TxtL) 1)
      (dcl-MessageBox "内容必须大于1个汉字。" "晓东提示" 2 4)
      (progn
        (dcl-form-Close DrawTxtAtLine)
        (if (and (= 1 #DrawAtLine_DLineCheck)
                 (setq p1 (getpoint "\n文字起点<退出>:"))
                 (setq p2 (getpoint p1 "\n文字终点<退出>:"))
            )
          (progn (setq p1 (trans p1 1 0)
                       p2 (trans p2 1 0)
                 )
                 (xdrx_polyline_make p1 p2)
                 (setq DLEnt (entlast))
                 (setq e1 DLEnt
                       e2 e1
                 )
                 (setq a1 0.0)
                 (setq a2 (distance p1 p2))
          )
          (progn (if (and (setq        e1 (xdrx_entsel
                                     "\n拾取曲线起点<退出>:"
                                     '((0 . "*line,arc,ellipse,circle"))
                                   )
                          )
                          (setq p1 (cadr e1))
                          (setq p1 (osnap p1 "nea"))
                          (setq e1 (car e1))
                          (setq        e2 (xdrx_entsel
                                     "\n拾取曲线终点<退出>:"
                                     '((0 . "*line,arc,ellipse,circle"))
                                   )
                          )
                          (equal e1 (car e2))
                     )
                   (progn (setq p2 (cadr e2))
                          (setq e2 (car e2))
                          (setq p2 (osnap p2 "nea"))
                          (setq        sub (xd::curve:getsub
                                      e1
                                      (trans p1 1 0)
                                      (trans p2 1 0)
                                      (trans p1 1 0)
                                    )
                          )
                          (xdge::entity:make sub)
                          (setq e1 (entlast))
                   )
                 )
          )
        )
        (if (and p1 p2)
          (progn
            (if        (= 1 (length txtl))
              (progn (xdrx_text_make p1 (car txtl) txtH "0.0")
                     (setq m (xdrx_matrix_align
                               p1
                               '(1 0 0)
                               (xdrx_vector_normalize
                                 (xdrx_curve_getfirstderiv e1 p1)
                               )
                             )
                     )
                     (xdrx_entity_transform (entlast) m)
              )
              (progn
                (setq dir (xdrx_vector_normalize (mapcar '- p2 p1)))
                (if (= 1 (dcl-Control-GetCurrentSelection Direction))
                  (setq dir (xdrx_vector_perpvector dir))
                )
                (setq w 0)
                (if (= 0 #DrawAtLine_Direction)
                  (progn (xdrx_text_make '(0 0 0) (last txtl) txtH "0.0")
                         (setq box (xdrx_text_box (entlast))
                               w   (distance (car box) (cadr box))
                         )
                         (xdrx_entity_delete (entlast))
                  )
                )
                (setq w          0
                      dis (/ (- (xdrx_getpropertyvalue e1 "length") w)
                             (1- (length txtl))
                          )
                      dis (abs dis)
                      pa1 (xdrx_curve_getparamatpoint e1 p1)
                      pa2 (xdrx_curve_getparamatpoint e1 p2)
                )
                (if (> pa1 pa2)
                  (setq pts (xdrx_curve_getPointsAtDist e1 p1 (- dis)))
                  (setq pts (xdrx_curve_getPointsAtDist e1 (abs dis)))
                )
                (setq i 0)
                (foreach n txtl
                  (xdrx_text_make (setq pt (nth i pts)) n txtH "0.0")
                  (XD::Text:SetAlignment (entlast) pt "bc")
                  (setq i (1+ i))
                  (setq        dir (xdrx_vector_normalize
                              (xdrx_curve_getfirstderiv e1 pt)
                            )
                        dir (if        (> pa1 pa2)
                              (xdrx_vector_negate dir)
                              dir
                            )
                        m1  (xdrx_matrix_settranslation
                              (xdrx_vector_product
                                (xdrx_vector_perpvector dir)
                                (atof #DrawAtLine_Gap)
                              )
                            )
                        m   (xdrx_matrix_align
                              pt
                              (if (= 0 #DrawAtLine_Direction)
                                '(1 0 0)
                                '(0 -1 0)
                              )
                              dir
                            )
                        m   (xdrx_matrix_product m1 m)
                  )
                  (xdrx_entity_transform (entlast) m)
                )
                (if sub
                  (progn (xdge::free sub) (xdrx_entity_delete e1))
                )
              )
            )
          )
        )
        (if DLEnt
          (xdrx_entity_delete DLEnt)
        )
      )
    )
  )
  (defun c:DrawLineCheck_OnClicked (Value /)
    (if        (= 0 Value)
      (progn (dcl-Control-SetEnabled DrawAtLine_Gap t)
             (dcl-Control-SetEnabled DrawAtLine_GapText t)
      )
      (progn (dcl-Control-SetEnabled DrawAtLine_Gap nil)
             (dcl-Control-SetEnabled DrawAtLine_GapText nil)
      )
    )
  )
  (defun c:TextAtLine_Cancel#OnClicked (/)
    (dcl-form-close DrawTxtAtLine)
  )
  (defun c:DrawTxtAtLine#OnInitialize (/)
    (if        #XDTB_GLOBALVAR_Txtbox
      (dcl-Control-SetText
        XD_DrawAtLine_Txtbox
        #XDTB_GLOBALVAR_Txtbox
      )
    )
    (if        #DrawAtLine_DLineCheck
      (progn (dcl-Control-SetValue
               XD_DrawLineCheck
               #DrawAtLine_DLineCheck
             )
             (if (= 0 #DrawAtLine_DLineCheck)
               (progn (dcl-Control-SetEnabled DrawAtLine_Gap t)
                      (dcl-Control-SetEnabled DrawAtLine_GapText t)
               )
               (progn (dcl-Control-SetEnabled DrawAtLine_Gap nil)
                      (dcl-Control-SetEnabled DrawAtLine_GapText nil)
               )
             )
      )
    )
    (if        #DrawAtLine_explode
      (dcl-Control-SetValue TxtAtLine_Alpha #DrawAtLine_explode)
    )
    (if        #DrawAtLine_Direction
      (dcl-Control-SetCurrentSelection
        Direction
        #DrawAtLine_Direction
      )
    )
    (if        #DrawAtLine_Gap
      (dcl-control-settext DrawAtLine_Gap #DrawAtLine_Gap)
    )
    (if        #txtH
      (dcl-control-settext XD_DrawAtLine_TxtHeight #txtH)
    )
    (if        #DrawLine_explode
      (dcl-Control-SetValue TxtAtLine_Alpha #DrawLine_explode)
    )
    (dcl-Control-SetFocus XD_DrawAtLine_Txtbox)
  )
  (defun c:Cancel_OnClicked (/)
    (dcl-form-Close DrawTxtAtLine)
  )
  (defun c:XD_DrawAtLine_Pick#OnClicked        (/)
    (setq #XDTB_GLOBALVAR_Txtbox (dcl-control-gettext XD_DrawAtLine_Txtbox))
    (dcl-form-close DrawTxtAtLine 4)

  )
  (defun _pick ()
    (if        (setq
          e (car (xdrx_entsel "\n拾取图中文字<退出>:" '((0 . "*text"))))
        )
      (progn (setq txt (xdrx_getpropertyvalue e "textstring")
                   txt
                    (xdrx_string_split txt "\r\n")
                   #XDTB_GLOBALVAR_Txtbox
                    (strcat #XDTB_GLOBALVAR_Txtbox (car txt))
             )
      )
    )
  )
  (xdrx_begin)
  (xdrx_sysvar_push "osmode" "cmdecho")
  (setvar "osmode" 0)
  (setvar "cmdecho" 0)
  (if (XD::Doc:AutoLoadOpenDCL)
    (progn (dcl-Project-Import TxtAtLine-ODCL-DATA)
           (setq doContinue T)
           (while doContinue
             (setq doContinue nil)
             (setq intResult (dcl_form_show DrawTxtAtLine))
             (cond ((= intResult 1) (setq doContinue nil)) ; ESC key
                   ((= intResult 2) (setq doContinue nil))
                   ((= intResult 3) (setq doContinue nil))
                   ((= intResult 4) (_pick) (setq doContinue t))
             )
           )
    )
  )
  (xdrx_sysvar_pop)
  (xdrx_end)
  (princ)
)

xcsdert

:loveliness::handshake:Q

qq787116960

xcsdert 发表于 2024-9-3 09:13
:loveliness::handshake:Q

帮我改下大佬  我不会代码