需要斜率lisp

Lee Mac · 发表于 2022-7-6 09:48:54

好吧，我忍不住。。。为了让你摆脱痛苦：

但是请阅读评论


(defun c:hc  (/ *error* vlst ovar cBlk tmp1 tmp2 tmp3 tmp4 blkpt)
 ; Error Handler
 (defun *error* (msg)
   (if ovar (mapcar 'setvar vlst ovar))  ; Return System Variables
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\n<< Error: " msg " >>")))  ; Print Error Message
   (princ))
 ; Collect and Set System Variables
 (setq vlst '("CMDECHO" "OSMODE")
       ovar (mapcar 'getvar vlst))
 (mapcar 'setvar vlst '(0 0))
 ; Set Defaults
 (or hc$slp:def (setq hc$slp:def 1))
 (or hc$cop:def (setq hc$cop:def 1))
 (or hc$spc:def (setq hc$spc:def 1))
 (or hc$dir:def (setq hc$dir:def "X"))
 ; Get Block to Copy
 (if (and (setq cBlk (car (entsel "\nSelect Block: ")))
          (eq "INSERT" (cdr (assoc 0 (entget cBlk)))))
   (progn
 ; Get User Input
     (initget 6)
     (setq tmp1 (getreal (strcat "\nSpecify Slope <" (rtos hc$slp:def) ">  1:")))
     (or (not tmp1) (setq hc$slp:def tmp1))
     (initget 6)
     (setq tmp2 (getint (strcat "\nSpecify Number of Copies <" (itoa hc$cop:def) "> : ")))
     (or (not tmp2) (setq hc$cop:def tmp2))
     (initget 6)
     (setq tmp3 (getreal (strcat "\nSpecify Spacing <" (rtos hc$spc:def) "> : ")))
     (or (not tmp3) (setq hc$spc:def tmp3))
     (initget "X Y")
     (setq tmp4 (getkword (strcat "\nSpecify Direction [X/Y] <" hc$dir:def "> : ")))
     (or (not tmp4) (setq hc$dir:def tmp4))
 ; Get Block Insertion Point Information and Initiate Counter
     (setq blkpt (cdr (assoc 10 (entget cBlk)))
           i     1)
 ; Copy the Block a Number of Times
     (repeat hc$cop:def
       (command "_copy" cBlk "" blkpt)
       (cond ((eq "X" hc$dir:def)
              (command
                (list (+ (* i hc$spc:def) (car blkpt))
                      (cadr blkpt)
                      (+ (* i hc$spc:def (/ 1 hc$slp:def)) (caddr blkpt)))))
             ((eq "Y" hx$dir:def)
              (command
                (car blkpt)
                (list (+ (* i hc$spc:def) (cadr blkpt))
                      (+ (* i hc$spc:def (/ 1 hc$slp:def)) (caddr blkpt))))))
       (command)
       (setq i (1+ i))))
   ; Else No Block was Selected
   (princ "\n<!> No Block Selected <!>"))
 ; Return Sys Vars Back
 (mapcar 'setvar vlst ovar)
 ; Exit Cleanly
 (princ))

NH3man! · 发表于 2022-7-6 09:52:22

好的，笔记本电脑在家里，安装好了。我将尝试在示例图形上编写代码。

谢谢你的时间和努力。

这是一个快速绘制我试图做什么，但在一个更大的规模。

再次感谢！
阻止移动。图纸

Lee Mac · 发表于 2022-7-6 09:54:01

好的，我只能打开2004或更早的格式。

NH3man! · 发表于 2022-7-6 09:57:25

很抱歉。
阻止移动。图纸

NH3man! · 发表于 2022-7-6 10:00:56

我确实尝试了你的代码，它确实有效，但我正在试图找出海拔变化如此剧烈的原因。我在48和斜率的x上做了一个拷贝。125，看起来它的海拔变化了125英尺。但这将比我的方式快得多。

再次感谢李

Lee Mac · 发表于 2022-7-6 10:04:04

我将输入的高程设置为，例如8代表0.125，4代表0.25等等

NH3man! · 发表于 2022-7-6 10:08:20

是这样吗。125/每12。我尝试了更高的数字，我正在接近使用75，但还没有安静。

此外，它只允许从原始块向一个方向移动。这没什么大不了的，我只需要记住把原来的积木放在那里。

谢谢李

Lee Mac · 发表于 2022-7-6 10:10:12

现在可以输入0.125作为坡度：

copy


(defun c:hc  (/ *error* vlst ovar cBlk tmp1 tmp2 tmp3 tmp4 blkpt)
 ; Error Handler
 (defun *error* (msg)
   (if ovar (mapcar 'setvar vlst ovar))  ; Return System Variables
   (if (not (member msg '("Function cancelled" "quit / exit abort")))
     (princ (strcat "\n<< Error: " msg " >>")))  ; Print Error Message
   (princ))
 ; Collect and Set System Variables
 (setq vlst '("CMDECHO" "OSMODE")
       ovar (mapcar 'getvar vlst))
 (mapcar 'setvar vlst '(0 0))
 ; Set Defaults
 (or hc$slp:def (setq hc$slp:def 1))
 (or hc$cop:def (setq hc$cop:def 1))
 (or hc$spc:def (setq hc$spc:def 1))
 (or hc$dir:def (setq hc$dir:def "X"))
 ; Get Block to Copy
 (if (and (setq cBlk (car (entsel "\nSelect Block: ")))
          (eq "INSERT" (cdr (assoc 0 (entget cBlk)))))
   (progn
 ; Get User Input
     (initget 6)
     (setq tmp1 (getreal (strcat "\nSpecify Slope <" (rtos hc$slp:def) "> : ")))
     (or (not tmp1) (setq hc$slp:def tmp1))
     (initget 6)
     (setq tmp2 (getint (strcat "\nSpecify Number of Copies <" (itoa hc$cop:def) "> : ")))
     (or (not tmp2) (setq hc$cop:def tmp2))
     (initget 6)
     (setq tmp3 (getreal (strcat "\nSpecify Spacing <" (rtos hc$spc:def) "> : ")))
     (or (not tmp3) (setq hc$spc:def tmp3))
     (initget "X Y")
     (setq tmp4 (getkword (strcat "\nSpecify Direction [X/Y] <" hc$dir:def "> : ")))
     (or (not tmp4) (setq hc$dir:def tmp4))
 ; Get Block Insertion Point Information and Initiate Counter
     (setq blkpt (cdr (assoc 10 (entget cBlk)))
           i     1)
 ; Copy the Block a Number of Times
     (repeat hc$cop:def
       (command "_copy" cBlk "" blkpt)
       (cond ((eq "X" hc$dir:def)
              (command
                (list (+ (* i hc$spc:def) (car blkpt))
                      (cadr blkpt)
                      [b][color=Red](+ (* i hc$spc:def hc$slp:def) (caddr blkpt))[/color][/b][color=Red][color=Black])[/color][/color]))
             ((eq "Y" hx$dir:def)
              (command
                (car blkpt)
                (list (+ (* i hc$spc:def) (cadr blkpt))
                      [b][color=Red](+ (* i hc$spc:def hc$slp:def) (caddr blkpt))[/color][/b][color=Red][color=Black])[/color][/color])))
       (command)
       (setq i (1+ i))))
   ; Else No Block was Selected
   (princ "\n<!> No Block Selected <!>"))
 ; Return Sys Vars Back
 (mapcar 'setvar vlst ovar)
 ; Exit Cleanly
 (princ))