j_spawn_h 发表于 2022-7-6 07:36:50

帮助放置文字。

这个Lisp程序正是我想要的。我写了一遍又一遍,直到我能做我想做的。多亏了你们的帮助,它从你们写的Lisp程序开始。它所做的是通过宽度和厚度来标记多边形线。我无法解决的问题是使文本超出行以清除文本。当我画一条5.25英寸或7英寸的折线时,文字部分隐藏。我试了所有我知道的可以移动它的东西,但只能使它向下或转弯。
 
(defun C:bd(/)

(setq   lstWidth '( "1.75" "3.5" "5.25" "7")
       lstDepth '("5.5" "6" "7.25" "8" "9.25" "9.5" "10" "11.25" "11.875" "12" "14" "16" "18" "24")
         lstmembr '("Flush Beam" "Header/Drop Beam")
lstSuffix '("PSL" "UWA" "UCA" "LVL" "LSL")
LSTSuffixs '("FRB" "UWA" "UCA")
lstPreffix '("1 ply" "2 ply" "3 ply"))

(or membr (setq membr (car lstmembr)))
(or preffix (setq preffix (car lstPreffix)))
(or width (setq width (car lstWidth)))
(or depth (setq depth (car lstDepth)))
(or suffix (setq suffix (car lstsuffix)))
(or suffixs (setq suffixs (car lstsuffixs)))

(setq dcl_id (load_dialog "beam.dcl"))                     
(if (not (new_dialog "beam" dcl_id)) (exit)                        
   (progn

       (set_tile membr "1")
       (set_tile preffix "1")
       (set_tile width "1")
       (set_tile depth "1")
       (set_tile suffix "1")
       (set_tile suffixs "1")

      (action_tile "kmembr" "(setq membr $value)")
   (action_tile "kpreffix" "(setq preffix $value)")
   (action_tile "kWidth" "(setq width $value)")
       (action_tile "kDepth" "(setq depth $value)")
   (action_tile "kSuffix" "(setq suffix $value)")
   (action_tile "kSuffixs" "(setq suffixs $value)")
       (start_dialog)
       (unload_dialog dcl_id)
   ))

(if(= membr "Flush Beam") (setq layer_name "S-FRM-BEAM"))

(if(= membr "Header/Drop Beam")(setq layer_name "S-FRM-HEADER"))
;(if (= depth "1")(setq depth ""))


(command "_.layer" "M" layer_name "c" "12" layer_name "S" layer_name "")
(command "pline" pause "w" width width pause "")
(command "chprop" "l" "" "t" depth "")
    (command "textsize" "6" "")
(command "_.style" "jaytxt" "romans" "0" "0.80" "" "" "" "")

(and (setq ss (ssget "L" '((0 . "*polyline"))))
    (while (setq en (ssname ss 0))
         (setq ed (entget en))
         (setq p10 (cdr (assoc 10 ed)))
         (setq p9 (reverse ed))
         (setq p11 (cdr (assoc 10 p9)))
          (setq mpt (mapcar '(lambda (a b) (* (+ a b) 0.5)) p10 p11))
         (setq ltype (cdr (cond
    ((assoc 6 ed)))))
         (setq dpth (cdr (cond
    ((assoc 39 ed)))))
         (setq wdth (cdr (cond
    ((assoc 40 ed)))))
;---------How many plys the member has----------
(if (= preffix "1.5") (and (= wdth 1.75)(setq label2 "2~")))
(if (= preffix "1.5") (and (> wdth 1.75)(setq label2 "2x")))
(if (= preffix "3")(setq label2 "2~2x"))
(if (= preffix "4.5")(setq label2 "3~2x"))
(if (= preffix "1")(setq label2 ""))
;----------Width of the member---------      
(if (= wdth 1.75)(setq label "1.75x"))
(if (= wdth 2.5)(setq label "I-JOIST/BEAM"))      
(if (= wdth 3.5)(setq label "3.5x"))
(if (= wdth 5.25)(setq label "5.25x"))
(if (= wdth 7)(setq label "7x"))
;----------Depth of the Member-------------      
(if (= dpth 5.5)(setq label1 (rtos dpth 2 1)))
(if (= dpth 6)(setq label1 (rtos dpth 2 0)))
(if (= dpth 7.25)(setq label1 (rtos dpth 2 2)))
(if (= dpth 9.25)(setq label1 (rtos dpth 2 2)))
(if (= dpth 9.5)(setq label1 (rtos dpth 2 1)))
(if (= dpth (setq label1 (rtos dpth 2 0)))
(if (= dpth 10)(setq label1 (rtos dpth 2 0)))
(if (= dpth 11.25)(setq label1 (rtos dpth 2 2)))
(if (= dpth 12)(setq label1 (rtos dpth 2 0)))
(if (= dpth 11.875)(setq label1 (rtos dpth 2 3)))
(if (= dpth 14)(setq label1 (rtos dpth 2 0)))
(if (= dpth 16)(setq label1 (rtos dpth 2 0)))
(if (= dpth 18)(setq label1 (rtos dpth 2 0)))
(if (= dpth 24)(setq label1 (rtos dpth 2 0)))      
(if (= dpth 0)(setq label1 ""))      




(defun radians->degrees (r)(cvunit r "radian" "degree"))
;-------TEXT JUSTIFICATION----------------------------------------   
      (setq lan (angle p10 p11))
(setq ad (radians->degrees lan))   
      (if (and (> ad 90.1) (<= ad 270.1))
      (progn
          (setq ptemp p10)
          (setq p10 p11)
          (setq p11 ptemp)
          (setq lan (angle p10 p11))      
          (setq ad (radians->degrees lan))))

      (setq dir (if (< (* pi 0.5) lan (* pi 1.5)) - +))


         (setq r3(entmake (list (cons 0 "TEXT")
                        (cons 8 (getvar "CLAYER"))
                        (cons 7 (getvar "TEXTSTYLE"))
                        (cons 40 (getvar "TEXTSIZE"))
                        (cons 41 0.80)
   (cons 72 4)
            (setq fg(cons 10 (setq r1(polar mpt (dir lan (+ 1))
                                 (getvar "TEXTSIZE")))))
                        (setq hg(cons 11 (setq r2(polar mpt (dir lan (+ 1))
                                 (getvar "TEXTSIZE")))))
                        (setq gg(cons 50 lan))
                         (setq rg(cons 1 (strcat label2 label label1 suffix suffixs))))))



                  (ssdel en ss)))
(command "_.layer" "on" "*" "" "")
(setvar "clayer" layerset)
(command "filedia" "1")



(princ)
)

MSasu 发表于 2022-7-6 07:44:32

张贴对话框定义也很有用;但是,要根据其宽度从多段线移动标签,请尝试:
快速浏览代码后的一些评论:
-检查COND函数,而不是多个IF:
前缀变量从该列表中取值:
'("1 ply" "2 ply" "3 ply")但后来与一些不相关的东西进行了比较:
试图恢复当前层,但从未分配LAYERSET变量。
你给很多从未使用过的变量赋值,比如FG、R1、HG等等。
-尝试使用局部变量以避免进一步冲突。
-为什么要重置FILEDIA?它不会干扰自定义对话框。
-尽量在代码上保持一致性——在例程的中间有一个函数定义;格式也很难理解。
 
 
通过使用代码标记而不是HTML,将缩小帖子的大小以获得更好的外观。

j_spawn_h 发表于 2022-7-6 07:56:41

谢谢你的帮助,但是移动文本的代码不起作用。我确实把ifs改成了conds。额外变量的原因是我要在不同的位置检查东西,这样我就可以找出问题所在。图层集未完成。另外,我拿出来的文件不需要,只是放错了。

j_spawn_h 发表于 2022-7-6 08:01:57

在我添加几行代码之前,它一直正常工作,但现在它被卡住了。无论我选择什么,宽度、深度、后缀、后缀都固定在同一个答案上。我知道这是我的代码中的一个小错误,但我昨天花了一整天都没找到它。
6
 
dcl代码
7

SLW210 发表于 2022-7-6 08:10:49

请为您发布的代码使用代码标记(正在使用HTML标记)。

MSasu 发表于 2022-7-6 08:20:53

@j_spawn_h:请发布更新的代码以进行进一步分析。非常感谢。

MSasu 发表于 2022-7-6 08:27:39

不知道你为什么要为此启动一个新线程。无论如何,为了解决您的问题,请注意DCL密钥区分大小写:
8
 
在标签放置方面,如果您决定遵循我之前的建议,请注意宽度变量实际上是一个字符串(因为您第一次没有发布对话框定义,我不知道这一点)。下面是固定代码:
9

SLW210 发表于 2022-7-6 08:30:02

线程合并。。。。。。。。。。

j_spawn_h 发表于 2022-7-6 08:37:55

Msasu,
非常感谢,效果很好。我想,因为我有一个关于lisp的不同问题,我需要一个新的线程,所以它不会被检查。我知道区分大小写,但没有注意到我在代码中更改了它。我想循环这个,这样我可以继续绘制相同的梁并标记它,直到我点击esc或什么。我试着去做,但我什么也做不到。我使用了“while”,但不确定这是否正确。我在一些地方添加了它,但什么都没有发生。我能在学校里学到些什么吗?
 
jspawnh公司
页: [1]
查看完整版本: 帮助放置文字。