污垢/土壤图案填充LISP
G'day，我们最近被一家新公司接管，我们现在使用AutoCAD 2009，然后使用AutoCAD 2006，定制cad由一位软件大师设计，他不知道与我们在一起。
我们过去有一个很好的污垢/土壤LISP，它会沿着一条最近的粘性线，并在污垢中绘制一个图案填充（使用Earth hatch）在任何你想要的长度，也可以缩放（附图片）。
现在，我们有了StrucPLUS AutoCAD软件包，它有一个非常普通的污垢/土壤块，它可以缩放，但只有块大小，你不能拉伸它或任何东西，除非你爆炸它（啊！线！）。
只是想知道是否有人像我解释的那样Lisp程序？
干杯
我不太确定，但欢迎你参加。它可能在那里。请参阅附件。
aec20patterns。拉链 嗯，不是真的，它们只是图案填充。
我是在寻找一个lisp，它将调用地球剖面线图案（标准的一个）在一定的比例，在45度。这样我就可以在一条线上选取2个点，并将该图案填充下来。
很抱歉。也许会有什么事情发生。 尝试制作一个地球图案填充块（以您希望看到绘制的大小/角度）；然后将其拖动到工具选项板。在新“工具”的属性中，可以将其插入“辅助比例”（Dimscale、Plot scale），也可以将其插入“旋转提示”（2个点）。
但这只会给你一个特定大小的区块？
比如，一旦你把它做成那个尺寸（就像沿着线的长度一样），每次你插入它时，它的大小都是一样的？
我喜欢把它们都做得不一样，让画作看起来不那么完美
我刚刚拼凑的东西。可能需要一些调整。
世界lsp
键入Earth以启动。
;/////////////////////////////////////////////////////////////////////////////////////////
;
(defun C:EARTH (/ CL01 CL02 RAD# DEG# PT01 PT02 PT03 PT04 DLEN E01 SCL WID ANG)
(setq PRP "EARTH")
(setq WID 12)
(setq SCL 12)
(setq ANG 0)
(setq CL01 (getpoint "\nSpecify first point: ")
CL02 (getpoint CL01 "\nSpecify second point: ")
RAD# (angle CL01 CL02)
DEG# (RTD RAD#)
DLEN (distance CL01 CL02)
CL01 (trans CL01 1 0)
CL02 (trans CL02 1 0)
PT01 CL01
PT02 (polar PT01 (DTR (+ DEG# 0)) DLEN)
PT03 (polar PT01 (DTR (+ DEG# 270)) WID)
PT04 (polar PT02 (DTR (+ DEG# 270)) WID))
(command "._pline" PT01 PT02 PT04 PT03 "C")
(setq E01 (entlast))
(command "._-bhatch" "_a" "_a" "_y" "" "_p" PRP SCL ANG "_s" "_l" "" "")
(command "._erase" E01 "")
(princ))
(princ)
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
(defun DTR (DEG#)(* pi (/ DEG# 180.0)))
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
(defun RTD (RAD#)(* 180.0 (/ RAD# pi)))
;
;///////////////////////////////////////////////////////////////////////////////////////// 这一个有更多的提示，使其更灵活。还添加了错误陷阱和层函数。
我在代码中注释了可能需要更改值的区域。请参阅以红色突出显示的值。
如果您需要帮助，请提及。
地球。lsp
键入EARTH以启动。
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Main Function.
;
(defun C:EARTH (/ CL01 CL02 RAD# DEG# PT01 PT02 PT03 PT04 DLEN E01 CPS SUS)
(setq SUS_LST (list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits" "clayer"))
(setq SUS (mapcar 'getvar SUS_LST))
(setq TERR *error*)
(setq *error* EARTH_ET)
(or H:PRP (setq H:PRP "EARTH")) ;Default Hatch Pattern
(or H:WID (setq H:WID 6)) ;Default Hatch Width
(or H:SCL (setq H:SCL 6)) ;Default Hatch Scale
(or H:ANG (setq H:ANG 45)) ;Default Hatch Angle
(setq H:WID
(cond
((getint (strcat "\nSpecify hatch width. <"(rtos H:WID 2 0)">: ")))(T H:WID)))
(setq H:SCL
(cond
((getint (strcat "\nSpecify hatch scale. <"(rtos H:SCL 2 0)">: ")))(T H:SCL)))
(setq H:ANG
(cond
((getint (strcat "\nSpecify hatch angle. <"(rtos H:ANG 2 0)">: ")))(T H:ANG)))
(setq CL01 (getpoint "\nSpecify first point: ")
CL02 (getpoint CL01 "\nSpecify second point: ")
RAD# (angle CL01 CL02)
DEG# (EARTH_RTD RAD#)
DLEN (distance CL01 CL02)
CL01 (trans CL01 1 0)
CL02 (trans CL02 1 0)
PT01 CL01
PT02 (polar PT01 (EARTH_DTR (+ DEG# 0)) DLEN)
PT03 (polar PT01 (EARTH_DTR (+ DEG# 270)) H:WID)
PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) H:WID))
(EARTH_CPS)
(EARTH_ML "HATCH" 1 "Continuous" 18) ;Set layer name, color, linetype, & lineweight
(setvar "clayer" "HATCH") ;Set HATCH layer current
(command "._pline" PT01 PT02 PT04 PT03 "C")
(setq E01 (entlast))
(command "._-bhatch" "_a" "_a" "_y" "" "_p" H:PRP H:SCL H:ANG "_s" "_l" "" "")
(command "._erase" E01 "")
(EARTH_RUS)
(princ))
(princ)
(princ "\nEARTH.lsp loaded... Type EARTH to start.")
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Degrees To Radians.
;
(defun EARTH_DTR (DEG#)(* pi (/ DEG# 180.0)))
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Radians To Degrees.
;
(defun EARTH_RTD (RAD#)(* 180.0 (/ RAD# pi)))
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Make Layer.
;
(defun EARTH_ML (LNAM LCLR LTYP LWGT)
(if (null (tblsearch "layer" LNAM))
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2LNAM)
(cons700)
(cons62LCLR)
(cons 6LTYP)
(cons 2901)
(cons 370LWGT))))
(princ))
(princ)
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Change Program Settings.
;
(defun EARTH_CPS ()
(setq CPS (list 0 1 0 0 0 0))
(mapcar (function setvar)(list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits") CPS)
(princ))
(princ)
;
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Restore User Settings.
;
(defun EARTH_RUS ()
(setq *error* TERR)
(if SUS (mapcar 'setvar SUS_LST SUS))
(princ "\nEARTH.lsp has completed successfully and will now restore your settings.")
(princ))
(princ)
;
;/////////////////////////////////////////////////////////////////////////////////////////
;
; Error Trap.
;
(defun EARTH_ET (ERRORMSG)
(command nil nil nil)
(if (not (member ERRORMSG '("console break" "Function cancelled")))
(princ (strcat "\nError:" ERRORMSG)))
(if SUS (mapcar 'setvar SUS_LST SUS))
(princ "\nEARTH.lsp has encountered a user error!")
(princ "\nProgram will now restore your settings and exit.")
(terpri)
(setq *error* TERR)
(princ))
(princ)
;
;/////////////////////////////////////////////////////////////////////////////////////////
洛克马克，
这个程序对你有用吗？
好奇的人想知道。 尊敬的先生：
Lisp程序很好
谢谢分享
但lisp中有一个问题
im选取第一点终点和第二点nea图案填充为genrete cross
页:
[1]
2