[求助]：初学LISP,请问各位：怎样用LISP画出下面的图形？

SLMin

要求提示输入长度L和宽度H,以及中心线所用的图层！（无标注）

xjjy

我也是初学LISP，很多不懂,只能用苯方法，请指教！

(defun c:cao ()
   (command "undo" "group")
   (setq osm (getvar "osmode"))
   (setvar "OSMODE" 0)
   (setq olderr *error*
     *error* clerr)

   (setq pt1 (getpoint "\n请输入中心点: "))
   (setq l1 (getreal "\n输入长度尺寸L <8>:"))
     (if (= l1 nil)
         (setq l1 8)
     )
   (setq l2 (getreal "\n输入宽度尺寸H <4>:"))
     (if (= l2 nil)
         (setq l2 4)
     )

   (setq oldlayer (getvar "clayer"))
        (IF (= (TBLSEARCH "LAYER" "cao") NUL)
            (COMMAND "LAYER" "N" "cao" "c" "7" "cao" "LT" "" "cao" ""))
   (setvar "clayer" "cao")

   (setq pt2 (polar pt1 0 (/ l1 2)))
   (setq pt3 (polar pt2 (- (/ pi 2)) (/ l2 2)))
   (setq pt4 (polar pt2 (/ pi 2) (/ l2 2)))

   (command "arc" "C" PT2 PT3 PT4)
   (command "LINE" "" (strcat "@" (rtos L1) ",0") "")

   (setq pt5 (polar pt1 PI (/ l1 2)))
   (setq pt6 (polar pt5 (/ pi 2) (/ l2 2)))
   (setq pt7 (polar pt5 (- (/ pi 2)) (/ l2 2)))

   (command "arc" "C" PT5 PT6 PT7)
   (command "LINE" "" (strcat "@" (rtos L1) ",0") "")
;;;
   (setvar "clayer" oldlayer)
   (setq oldlayer (getvar "clayer"))
        (IF (= (TBLSEARCH "LAYER" "cen") NUL)
            (COMMAND "LAYER" "N" "cen" "c" "1" "cen" "lt" "center" "cen" ""))
   (setvar "clayer" "cen")
   (setq l3 (getreal "\n输入中心线延伸量 <3>:"))
     (if (= l3 nil)
         (setq l3 3)
     )
   (setq pt8 (polar pt1 PI (+ (/ l1 2) l3 (/ l2 2))))
   (setq pt9 (polar pt1 0 (+ (/ l1 2) l3 (/ l2 2))))
   (command "LINE" pt8 pt9 "")

   (setq pt10 (polar pt1 (/ PI 2) (+ (/ l2 2) l3)))
   (setq pt11 (polar pt1 (-(/ PI 2)) (+ (/ l2 2) l3)))
   (command "LINE" pt10 pt11 "")

   (setvar "clayer" oldlayer)
   (setvar "osmode" osm)
   (setq *error* olderr)
   (command "regen")
   (command "undo" "end")
)

梦断江南

除了l方向的中心线,其他的用mline正好符合楼主的要求:)

whcdy

做成属性块是否更简单一些？不至于什么都要编程吧？

xyp1964

2楼的程序基本可以满足要求。
外框白色线最好为“POLYLINE”可以形成一个整体，宽、高数值应能格式化输入（充分利用上一次用户输入值），中心线设成“CENTER”线型，线型和线型比例用户可以自己设定和定义。
上传修改的 kc.lsp （孔槽程序），加载kc.lsp，运行kc。
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;KC.lsp 孔槽
;;;* C:KC
;;;xjjy 2004.10.07
;;;-- XYP@bsedi.com
;;;2004.10.07修改
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(prompt "\n\r      加载孔槽程序。")
;-------------------------------------------
;;;主程序
(defun c:kc (/ pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 l3 pw)
  (cmdla0)
  (setq pt1 (getpoint "\n\t请输入中心点: ")
        NO1 (ureal 1 "" "\n\t输入长度尺寸L" no1)
        NO2 (ureal 1 "" "\n\t输入宽度尺寸H" no2)
        )
  ;(setq txt1 (ustr 1 "\n\t中心线层名" txt1 nil))
  (mkla "孔槽外框" 7);用户自定义图层名称
  (setq pt2 (polar pt1 0 (/ NO1 2))
        pt3 (polar pt2 (- (/ pi 2)) (/ NO2 2))
        pt4 (polar pt2 (/ pi 2) (/ NO2 2))
        pt5 (polar pt1 PI (/ NO1 2))
        pt6 (polar pt5 (/ pi 2) (/ NO2 2))
        pt7 (polar pt5 (- (/ pi 2)) (/ NO2 2))
        )
  (setvar "plinewid"0);设多义线线宽为0
  (command "pline" pt4 pt6 "a" "a" "180" pt7 "L" pt3 "a" "a" "180" pt4 "cl")
  (mkla "孔槽中心线" 1);用户自定义图层名称
  (command "-layer" "l" "center""孔槽中心线""")
  (setq l3 (/ no2 4))
  (setq pt8 (polar pt1 PI (+ (/ NO1 2) l3 (/ NO2 2)))
        pt9 (polar pt1 0 (+ (/ NO1 2) l3 (/ NO2 2))))
  (command "LINE" pt8 pt9 "")
  (setq pt10 (polar pt1 (/ PI 2) (+ (/ NO2 2) l3))
        pt11 (polar pt1 (- (/ PI 2)) (+ (/ NO2 2) l3)))
  (command "LINE" pt10 pt11 "")
  (cmdla1)
  (pxyp"KC      (孔槽)")
  )
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
  )

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
  )

;;;
(defun ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp inp def)
  )
;;;
(defun ustr (bit msg def spflag / inp nval)
   (if (and def (/= def ""))
       (setq msg (strcat "\n" msg "<" def ">:")
             inp (getstring msg spflag)
             inp (if (= inp "") def inp)
       )
       (progn
         (setq msg (strcat "\n" msg ": "))
         (if (= bit 1)
             (while (= "" (setq inp (getstring msg spflag))))
             (setq inp (getstring msg spflag))
         )
       )        ; progn
   )            ; if
   (if inp inp def)
)
;;;
(Defun MKLA (a b)
  (If (= (Tblsearch "layer" a) nil)
    (Command "layer" "m" a "c" b a "")
    (Command "layer" "t" a "s" a "c" b a "")
    )
  )

;;;
(DEFUN PXYP (TXT1)
  (SETQ        TXT1 (STRCAT "\n\r      程序命令: "  TXT1 "      -- XYP@bsedi.com"))
  (PRINC TXT1)
  (Princ)
  );defun

;;;
(pxyp"KC      (孔槽)")
(princ)
;-------------------------------------------
;;;END

xyp1964

最初由 whcdy 发布
[B]做成属性块是否更简单一些？不至于什么都要编程吧？ [/B]

“定义属性块”如何定义？这儿不存在属性啊！而且插入块时如何保证两侧为标准半圆？

zxq0220

试一下这个程序：

(DEFUN C:SLOT (/ L W PT A A1 A2 A3 W5 P1 P2 P3 P4
                 PC1 PC2 PC3 PC4 PC5 PC6 OLDL OLDOS)
(SETQ L (GETDIST "\nInput Length of Slot 输入槽长 <12> : ")
      L (IF (= L nil) 12 L)
      W (GETDIST "\nInput Width of Slot 输入槽宽 <4> : ")
      W (IF (= W nil) 4 W))
(IF (SETQ PT (GETPOINT "\nInsert Point 插入点 : ")) (PROGN
(SETQ A 0 A1 (* PI 0.5) A2 PI A3 (- A1) W5 (* W 0.5) W6 (* W 0.6)
       P1 (POLAR PT A1 W5)  P2 (POLAR P1 A3 W)
       P3 (POLAR PT A (- L W)) P4 (POLAR P3 A3 W5)
       PC1 (POLAR PT A2 W6)  PC2 (POLAR P3 A W6)
       PC3 (POLAR PT A1 W6)  PC4 (POLAR PT A3 W6)
       PC5 (POLAR P3 A1 W6)  PC6 (POLAR P3 A3 W6)
       P3 (POLAR P3 A1 W5)  SS (SSADD)
       OLDL (GETVAR "CLAYER") OLDOS (GETVAR "OSMODE"))
(SETVAR "BLIPMODE" 0) (SETVAR "CMDECHO" 0) (SETVAR "OSMODE" 0)
(IF (= (TBLSEARCH "LAYER" "CEN") NUL)
  (COMMAND "LAYER" "N" "CEN" "c" "1" "CEN" "LT" "CENTER2" "CEN" "S" "CEN" "")
  (SETVAR "CLAYER" "CEN")
)
(COMMAND "LINE" PC1 PC2 "") (SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PC3 PC4 "") (SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "LINE" PC5 PC6 "") (SETQ SS (SSADD (ENTLAST) SS))
(IF (= (TBLSEARCH "LAYER" "SLOT") NUL)
  (COMMAND "LAYER" "N" "SLOT" "c" "7" "SLOT" "S" "SLOT" "")
  (SETVAR "CLAYER" "SLOT")
)
(COMMAND "PLINE" P2 P4 "A" P3 "L" P1 "A" "CL")
(SETQ SS (SSADD (ENTLAST) SS))
(COMMAND "ROTATE" SS "" PT PAUSE)
(SETVAR "BLIPMODE" 1) (SETVAR "OSMODE" OLDOS)
(SETVAR "CLAYER" OLDL) (SETVAR "CMDECHO" 1)
))
(PRINC)
)

程序在R14上调试通过。

SLMin

最初由 whcdy 发布
[B]做成属性块是否更简单一些？不至于什么都要编程吧？ [/B]

不是要用lisp来画这个图，而是为了学习LISP语言！！！