bao 发表于 2022-7-6 17:11:24

修剪Lisp程序

怎么了，伙计们？有人有“chop lisp”吗？我换电脑了，忘了保存程序，我的“lsp”都丢失了。它是一种可以修剪线条的东西，但你可以给它在每一边的修剪方式提供一定的值。
提前谢谢，非常感谢。

GhostRider 发表于 2022-7-6 17:30:25

就是这个吗？我不认为这是文本
 
(defun C:CHOP (/ rad2deg txt2edit chopword entname entdata dotpairtxt dotpairht ht dotpairang rotang longtxt wordlen longtxtlen counter teststr)
(setvar "CMDECHO" 0)
(setq Rad2Deg (/ 360 pi 2))
(setq Txt2Edit (ssget))
(setq ChopWord (getstring "\nChop after what word?: "))
(setq EntName (ssname Txt2Edit 0))
(setq EntData (entget EntName))
(setq DotPairTxt (assoc (quote 1.0) EntData))
(setq DotPairHt (assoc (quote 40.0) EntData))
(setq Ht (cdr DotPairHt))
(setq DotPairAng (assoc (quote 50.0) EntData))
(setq RotAng (cdr DotPairAng))
(setq RotAng (* RotAng Rad2Deg))
(setq LongTxt (cdr DotPairTxt))
(setq WordLen (strlen ChopWord))
(setq LongTxtLen (strlen LongTxt))
(FINDWORD)
)
(defun FINDWORD ()
(setq Counter 1)
(setq TestStr (substr LongTxt Counter WordLen))
(while (not (equal TestStr ChopWord))
   (progn
      (setq Counter (+ 1 Counter))
      (setq TestStr (substr LongTxt Counter WordLen))
   )
)
(FINISHED)
)
(defun FINISHED (/ beforlen befortxt aftstart afttxt aftpt)
(setq BeforLen (+ Counter WordLen))
(setq BeforTxt (substr LongTxt 1 BeforLen))
(setq AftStart (+ 1 BeforLen))
(setq AftTxt (substr LongTxt AftStart))
(command "CHANGE" "prev" "" "" "" "" "" "" BeforTxt)
(setq AftPt (getpoint "\nStarting point of remaining text:"))
(command "TEXT" AftPt Ht RotAng AftTxt)
(setvar "CMDECHO" 1)
)
(prompt "\nCommand: CHOP - Break a text string\n")

bao 发表于 2022-7-6 17:40:16

是的，这个命令是CHOP，但不是用于文本。它适用于线条，比如你在画一个图表，你想修剪一条交叉的线条。所以，你不用“修剪”，而是用chop。你有吗？如果你觉得可以的话，可以发邮件给我吗？我的电子邮件是rlapaz@dvpe.net
谢谢

lpseifert 发表于 2022-7-6 17:52:45

加长命令不管用吗？

CmdrDuh 发表于 2022-7-6 18:01:29

我有一个叫bkwr的可能就是你想要的
(DEFUN C:Bkwr (/ PT PT1 PT2 PT3 A1)
(modes '("CMDECHO" "osmode" "orthomode"))
(PROMPT "\n \nBreak @ Intersection")
(INITGET 1)
(SETVAR "OSMODE" 32)
(COMMAND "SNAP" "OFF")
(setq dsc (getvar "dimscale"))
(SETQ PT1 (GETPOINT "\n\n Pick intersection to be broken: "))
(SETVAR "OSMODE" 0)
(INITGET 33)
(SETVAR "OSMODE" 512)
(SETQ PT (GETPOINT PT1 "\n Pick Line to be broken: "))
(IF (= BRKW NIL)
   (SETQ BRKW 0.0625)   ;set wire gap here. Gap is double the value set
)
(SETQ A1(ANGLE PT1 PT)
PT2 (POLAR PT1 A1 (* dsc BRKW))
PT3 (POLAR PT1 (+ A1 PI) (* dsc BRKW))
)
(COMMAND ".BREAK" PT "F" PT2 PT3)
(moder)
)

BOB'27T 发表于 2022-7-6 18:22:07

这个怎么样？
切碎拉链
页: [1]
查看完整版本: 修剪Lisp程序