污垢/土壤图案填充LISP 乐筑天下 - Powered by Discuz! Archiver

The Buzzard 发表于 2022-7-6 11:10:42

我这边没有错，代码只创建了一个像下面这样的地球舱口。

autolisp 发表于 2022-7-6 11:15:44

命令：接地
指定图案填充宽度：50
指定图案填充比例：50
指定图案填充角度：
指定第一个点：
指定第二点：nea到
地球。lsp已成功完成，现在将恢复您的设置。

The Buzzard 发表于 2022-7-6 11:17:45

我只是用您使用的相同值进行了测试，没有出现问题。我不知道你是怎么做到的。

The Buzzard 发表于 2022-7-6 11:21:48

好的，我明白了。您从一个非常大的图案填充设置切换回一个更小的设置。
我不知道该怎么办，因为手动运行hatch命令时也会发生这种情况。如果图纸已关闭
然后重启，一切似乎又开始了。我无法理解你为什么要从一个极端走向另一个极端。
我希望能找到一个解决方法，但在使用时，应该使用一些常见的acad常识。也许舱口的entmake是
一个更好的主意。

The Buzzard 发表于 2022-7-6 11:23:25

感谢您测试autolisp，

我想我已经解决了这个问题。我使用entmake创建图案填充，而不是命令调用。从一个极端到另一个极端，现在似乎没有问题。还要注意，代码运行得更快。

世界lsp

;/////////////////////////////////////////////////////////////////////////////////////////
;
; Main Function.
;
;
(defun C:EARTH (/ CL01 CL02 CPS DEG# DLEN E01 HANG HPRP HSCL HWID RAD# PT01 PT02 PT03 PT04 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 HPRP H:PRP
   HSCL H:SCL
   HWID H:WID
   HANG (EARTH_DTR H:ANG)
   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)) HWID)
   PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) HWID))
(EARTH_CPS)
(EARTH_ML "HATCH" 1 "Continuous" 18) ;Set layer name, color, linetype, & lineweight
(setvar "clayer" "HATCH")          ;Set HATCH layer current
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 "Model")
(cons 8 "0")
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 1)
(cons 43 0.0)
(cons 38 0.0)
(cons 39 0.0)
(cons 10 PT01)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT02)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT04)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT03)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 210 (list 0.0 0.0 1.0))))
(setq E01 (entlast))
(entmake
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 "Model")
(cons 8 "HATCH")
(cons 100 "AcDbHatch")
(cons 10(list0.0 0.0 0.0))
(cons 210 (list0.0 0.0 1.0))
(cons 2 HPRP)
(cons 70 0)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 4)
(cons 72 1)
(cons 10 PT01)
(cons 11 PT02)
(cons 72 1)
(cons 10 PT02)
(cons 11 PT04)
(cons 72 1)
(cons 10 PT04)
(cons 11 PT03)
(cons 72 1)
(cons 10 PT03)
(cons 11 PT01)
(cons 97 0)
(cons 75 0)
(cons 76 1)
(cons 52 HANG)
(cons 41 HSCL)
(cons 77 0)
(cons 78 6)
(cons 53 0.785398)
(cons 43 0.0)
(cons 44 0.0)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 0.785398)
(cons 43-0.397748)
(cons 44 0.397748)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 0.785398)
(cons 43-0.795495)
(cons 44 0.795495)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43-0.795495)
(cons 44 1.06066)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43-0.397748)
(cons 44 1.45841)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43 1.11022e-016)
(cons 44 1.85616)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 98 1)
(cons 10(list0.0 0.0 0.0))))
(command "._erase" E01 "")
(setenv "MaxHatch" "100")
(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)
;
;/////////////////////////////////////////////////////////////////////////////////////////

The Buzzard 发表于 2022-7-6 11:26:50

消除所有命令调用。这是一个entmake代码。看来entmake值得这么麻烦。
请欣赏。

世界lsp

;/////////////////////////////////////////////////////////////////////////////////////////
;
; Main Function.
;
;
(defun C:EARTH (/ CL01 CL02 CPS DEG# DLEN E01 HANG HPRP HSCL HWID RAD# PT01 PT02 PT03 PT04 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 HPRP H:PRP
   HSCL H:SCL
   HWID H:WID
   HANG (EARTH_DTR H:ANG)
   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)) HWID)
   PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) HWID))
(EARTH_CPS)
(EARTH_ML "HATCH" 1 "Continuous" 18) ;Set layer name, color, linetype, & lineweight
(setvar "clayer" "HATCH")          ;Set HATCH layer current
(entmake
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 "Model")
(cons 8 "0")
(cons 100 "AcDbPolyline")
(cons 90 4)
(cons 70 1)
(cons 43 0.0)
(cons 38 0.0)
(cons 39 0.0)
(cons 10 PT01)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT02)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT04)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 10 PT03)
(cons 40 0.0)
(cons 41 0.0)
(cons 42 0.0)
(cons 210 (list 0.0 0.0 1.0))))
(setq E01 (entlast))
(entmake
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 67 0)
(cons 410 "Model")
(cons 8 "HATCH")
(cons 100 "AcDbHatch")
(cons 10(list0.0 0.0 0.0))
(cons 210 (list0.0 0.0 1.0))
(cons 2 HPRP)
(cons 70 0)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 4)
(cons 72 1)
(cons 10 PT01)
(cons 11 PT02)
(cons 72 1)
(cons 10 PT02)
(cons 11 PT04)
(cons 72 1)
(cons 10 PT04)
(cons 11 PT03)
(cons 72 1)
(cons 10 PT03)
(cons 11 PT01)
(cons 97 0)
(cons 75 0)
(cons 76 1)
(cons 52 HANG)
(cons 41 HSCL)
(cons 77 0)
(cons 78 6)
(cons 53 0.785398)
(cons 43 0.0)
(cons 44 0.0)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 0.785398)
(cons 43-0.397748)
(cons 44 0.397748)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 0.785398)
(cons 43-0.795495)
(cons 44 0.795495)
(cons 45 2.22045e-016)
(cons 46 2.12132)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43-0.795495)
(cons 44 1.06066)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43-0.397748)
(cons 44 1.45841)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 53 2.35619)
(cons 43 1.11022e-016)
(cons 44 1.85616)
(cons 45-2.12132)
(cons 46 4.44089e-016)
(cons 79 2)
(cons 49 1.5)
(cons 49-1.5)
(cons 98 1)
(cons 10(list0.0 0.0 0.0))))
(entdelE01)
(setenv "MaxHatch" "100")
(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)
;
;/////////////////////////////////////////////////////////////////////////////////////////

alanjt 发表于 2022-7-6 11:30:10

上述情况通常可归因于运行OSNAP。

The Buzzard 发表于 2022-7-6 11:32:36

谢谢alan，但我没有设置osnaps，尽管其他人可能已经设置了osnaps。我应该禁用它们，但使用entmake这不是问题。我无法克服执行程序从头到尾的速度差异。这是一个不同的世界。

alanjt 发表于 2022-7-6 11:35:27

这就是我的意思。我知道你没有运行它们，但运行OSNAP会引发这样的问题——永远不要低估在每个点输入之前关闭OSNAP或“不”的力量。
我肯定现在快多了。干得好，我讨厌和entmake打交道。

The Buzzard 发表于 2022-7-6 11:38:34

我完全明白你的意思，我讨厌处理entmake，但归根结底还是值得的。我恐怕一开始就应该这么做。

页: 1 [2]

乐筑天下's Archiver