论坛大佬的代码 求各位大佬帮我改下 把生成的文字变成匿名块 谢谢
本帖最后由 qq787116960 于 2024-8-29 13:24 编辑论坛的代码求大佬帮我改下把生成的文字变成一个匿名块 谢谢
(defun c:沿线写字 (/ a1 a2 am amlan boxcen dir
DLEnt e e1 e2 from h i len
matn p p1 p2 pa pl pv tf
tf1to tox toytoztxtptssub pa1
pa2m 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]|+"
"[\\u4E00-\\u9FA5]|"
)
#XDTB_GLOBALVAR_Txtbox
)
len(length txtL)
tf1nil
)
(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)
)
:loveliness::handshake:Q xcsdert 发表于 2024-9-3 09:13
:loveliness::handshake:Q
帮我改下大佬我不会代码
页:
[1]