[编程交流] 需要帮助修改标签Lwpo

(vl-load-com)
(defun c:Label_Width ( / js htx AcDoc Space nw_style obj dxf_ent ename t_mod key pr t_char js_text pt deriv rtx nw_obj n)
(princ "\nSelect a polyline.")
(while
(null
(setq js
(ssget "_+.:E:S"
(list
'(0 . "*POLYLINE")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
)
(princ "\nIsn't an available object for this fonction!")
)
 (setq
   obj (ssname js 0)
   dxf_ent (entget obj)
   ename (vlax-ename->vla-object obj)
   t_mod '+
   key "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
     (initget 6)
     (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
     (if htx (setvar "TEXTSIZE" htx))
     (setq
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (cond
       ((null (tblsearch "LAYER" "Label"))
         (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
       )
     )
     (cond
       ((null (tblsearch "STYLE" "Romand-Label"))
         (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
         (mapcar
           '(lambda (pr val)
             (vlax-put nw_style pr val)
           )
           (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
           (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
         )
       )
     )
     (repeat 2
       (setq pr -0.5 t_char 64 js_text (ssadd))
       (if (eq key "Yes")
         (repeat (fix (vlax-curve-getEndParam ename))
           (setq
             pt (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
             deriv (vlax-curve-getFirstDeriv ename pr)
             rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
           )
           (setq nw_obj
             (vla-addMtext Space
               (vlax-3d-point (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
               0.0
               (strcat
                 "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                 (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
                 ">%).ConstantWidth \\f "%lu2">%"
               )
             )
           )
           (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
           (mapcar
             '(lambda (pr val)
               (vlax-put nw_obj pr val)
             )
             (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
             (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx)
           )
           (ssadd (entlast) js_text)
         )
       )
       (if (not (eq t_mod '-))
         (progn
           (initget "Yes No")
           (if (eq (setq key (getkword "\nPut labels on other side [Yes/No]? <No>: ")) "Yes")
             (progn (setq n -1 t_mod '-) (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n))))))
             (setq t_mod '-)
           )
         )
       )
     )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
(prin1)
)

(vl-load-com)
(defun c:Label_Width ( / js htx AcDoc cLay Space nw_style obj dxf_ent ename t_mod key pr t_char js_text pt deriv rtx nw_obj n)
(princ "\nSelect a polyline.")
(while
(null
(setq js
(ssget "_+.:E:S"
(list
'(0 . "*POLYLINE")
(cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
(cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
)
)
)
)
(princ "\nIsn't an available object for this fonction!")
)
 (setq
   obj (ssname js 0)
   dxf_ent (entget obj)
   ename (vlax-ename->vla-object obj)
   cLay(vla-get-Layer ename)
   t_mod '+
   key "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
     (setq
       AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       Space
       (if (= 1 (getvar "CVPORT"))
         (vla-get-PaperSpace AcDoc)
         (vla-get-ModelSpace AcDoc)
       )
     )
     (repeat 2
       (setq pr -0.5 t_char 64 js_text (ssadd))
       (if (eq key "Yes")
         (repeat(fix (vlax-curve-getEndParam ename))
           (setq
             pt (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
             deriv (vlax-curve-getFirstDeriv ename pr)
             rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
           )
           (setq nw_obj
             (vla-addMtext Space
               (vlax-3d-point (setq pt (polar pt ((eval t_mod) rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
               0.0
               (strcat "DN"
                 "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                 (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
                 ">%).ConstantWidth >% * 1000) \\f "%lu2%pr0">%"
               )
             )
           )
           (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
           (mapcar
             '(lambda (pr val)
               (vlax-put nw_obj pr val)
             )
             (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
             (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") cLay rtx)
           )
           (ssadd (entlast) js_text)
         )
       )
       (if (not (eq t_mod '-))
         (progn
           (initget "Yes No")
           (if (eq (setq key (getkword "\nPut labels on other side [Yes/No]? <No>: ")) "Yes")
             (progn (setq n -1 t_mod '-) (repeat (sslength js_text) (entdel (ssname js_text (setq n (1+ n))))))
             (setq t_mod '-)
           )
         )
       )
     )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
(prin1)
)