harilalmn 发表于 2022-7-6 09:44:18

好啊谢谢大家的回复。。。如果我在我想做的事情上成功了,我一定会发布代码。

Tharwat 发表于 2022-7-6 09:47:46

 
不要忘记本地化变量。

harilalmn 发表于 2022-7-6 09:48:53

 
当然谢谢Tharwat。。。。

Lee Mac 发表于 2022-7-6 09:53:26

下面是一个供您考虑的程序harilalmn,它使用了我在之前的帖子中描述的方法。
 
你自己试试看吧
 
;; Scroll down after you have tried to write it yourself   ;-)




































(defun c:stairs ( / _line a1 a2 go no p0 p1 p2 wi )

   (defun _line( p1 p2 )
       (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
   )

   (if
       (and
         (setq p0 (getpoint "\nSpecify First Point: "))
         (setq a1 (getangle "\nSpecify Stair Angle: " p0))
         (setq wi (getdist"\nSpecify Stair Width: "))
         (progn
               (initget 6)
               (setq no (getint "\nSpecify Number of Stairs: "))
         )
         (setq go (getdist "\nGoing: " p0))
       )
       (progn
         (setq p0 (trans p0 1 0)
               p1 (polar p0 (+ a1 (/ pi 2.0)) (/ wi 2.0))
               a2 (- a1 (/ pi 2.0))
         )
         (repeat (1+ no)
               (_line p1 (polar p1 a2 0.05))
               (_line    (polar p1 a2 0.1) (polar p1 a2 (- wi 0.1)))
               (_line    (polar p1 a2 (- wi 0.05)) (polar p1 a2 wi))
               (setqp1 (polar p1 a1 go))
         )
         (setq p1 (polar p0 a2 (- (/ wi 2.0) 0.1)))
         (repeat 2
               (setq p2 (polar p1 a2 0.05))
               (entmakex
                   (list
                     (cons 0 "LWPOLYLINE")
                     (cons 100 "AcDbEntity")
                     (cons 100 "AcDbPolyline")
                     (cons 90 4)
                     (cons 70 1)
                     (cons 10 (polar p1 a1 (+ (* no go) 0.2)))
                     (cons 10 (polar p2 a1 (+ (* no go) 0.2)))
                     (cons 10 (polar p2 a1 -0.2))
                     (cons 10 (polar p1 a1 -0.2))
                   )
               )
               (setq p1 (polar p1 a2 (- 0.15 wi)))
         )
       )
   )
   (princ)
)

harilalmn 发表于 2022-7-6 09:56:51

谢谢李。。,我有一个很好的开始。。。

harilalmn 发表于 2022-7-6 10:02:42

大家好,
最后有东西在工作。。。!!!
它需要图形中的四个层。
 
A-ANNO-TEXT(文本)
A-ANNO-DIMS(尺寸)
A-FLOR-HRAL(扶手)
A-DETL-HIDN(隐藏线)
 
假设文字和尺寸标注是注释性的。
 
我知道你们会有太多的评论。。。等待。。!!!

(defun c:str()
(vl-load-com)
(setq CURRENTLAYER (getvar "CLAYER"))
(setq OSM (getvar "OSMODE"))

(setq CuttingAt 1.2)

(setq C1(getpoint "\nStair Start Point:"))
(setq C2(getpoint C1 "\nStair End Point:"))

(setq width 1.0)
(setq tread 0.3)
(setq rise 0.15)
(setq FH 3.0)
(setq HOfst 0.05)
(setq HOvhg 0.20)
(setq HThik 0.05)
(setq info (strcat "\nStair Width : " (rtos Width)))
(setq info (strcat info ", Tread : " (rtos tread)))
(setq info (strcat info ", Rise : " (rtos Rise)))
(setq info (strcat info ", Floor Height : " (rtos FH)))
(setq info (strcat info ", Handrail Offset : " (rtos HOfst)))
(setq info (strcat info ", Handrail Overhang : " (rtos HOvhg)))
(setq info (strcat info ", Handrail Thickness : " (rtos HThik)))

(prompt info)
(textscr)
(initget 1 "Yes No")
(setq ConfirmInfo (getkword "\nDo you want to change these default stair properties? (Yes or No):"))
(textscr)

(if
(eq ConfirmInfo "Yes")

(progn
(setq Width(getdist "\nWidth:<1.00>"))
(if (null Width) (setq Width 1.00))
(setq info (strcat "\nStair Width : " (rtos Width)))

(setq tread(getdist "\nTread:<0.30>"))
(if (null tread) (setq tread 0.30))
(setq info (strcat info ", Tread : " (rtos tread)))

(setq Rise(getdist "\nRise:<0.15>"))
(if (null Rise) (setq Rise 0.15))
(setq info (strcat info ", Rise : " (rtos Rise)))

(setq FH(getdist "\nFloor Height:<3.00>"))
(if (null FH) (setq FH 3.00))
(setq info (strcat info ", Floor Height : " (rtos FH)))

(setq HOfst(getdist "\nHandrail Offset:<0.05>"))
(if (null HOfst) (setq HOfst 0.05))
(setq info (strcat info ", Handrail Offset : " (rtos HOfst)))

(setq HOvhg(getdist "\nHandrail Overhang:<0.25>"))
(if (null HOvhg) (setq HOvhg 0.25))
(setq info (strcat info ", Handrail Overhang : " (rtos HOvhg)))

(setq HThik(getdist "\nHandrail Thickness:<0.05>"))
(if (null HThik) (setq HThik 0.05))
(setq info (strcat info ", Handrail Thickness : " (rtos HThik)))

(prompt info)
);Progn
);If

(initget 1 "Yes No")
(setq Confirm (getkword "\nIs it the first flight? (Yes or No):"))

(setq HalfWidth (/ Width 2))
(setq NumberOfSteps(Round (/ FH Rise)))
(setq Dir(Angle C1 C2))
(setq s1 (polar c1 (+ (Getper Dir) (dtor 180)) HalfWidth))
(setq s2 (polar s1 (Getper Dir) HOfst))
(setq s3 (polar s2 (Getper Dir) HThik))
(setq s4 (polar s3 (Getper Dir) (* (- HalfWidth (distance s1 s3))2)))
(setq s5 (polar s4 (Getper Dir) HThik))
(setq s6 (polar s5 (Getper Dir) HOfst))

(setq DimOuter (polar s1 (+ (dtor 180) dir) (* 4 tread)))
(setq DimClear (polar s1 (+ (dtor 180) dir) (* 2 tread)))

(setvar "OSMODE" 0)

(command "-DIMSTYLE" "R" "Annotative")
(setvar "CLAYER" "A-ANNO-DIMS")
(command "_DIMALIGNED" s1 s6 DimOuter)
(command "_DIMALIGNED" s3 s4 DimClear)

(if
   (eq Confirm "Yes")
   (setvar "CLAYER" "A-FLOR-STRS")
   (setvar "CLAYER" "A-DETL-HIDN")
);If

(if
   (eq Confirm "Yes")
   (progn
   (setq ContRisers (fix (/ CuttingAt rise)))
   (setq HrLengthCont(+ HOvhg (* (- ContRisers 1) tread)))
   (setq ha1 (polar s4 (+ (dtor 180) dir) HOvhg))
   (setq ha2 (polar s5 (+ (dtor 180) dir) HOvhg))
   (setq ha3 (polar ha1 dir HrLengthCont))
   (setq ha4 (polar ha2 dir HrLengthCont))

   (setq hb1 (polar s2 (+ (dtor 180) dir) HOvhg))
   (setq hb2 (polar s3 (+ (dtor 180) dir) HOvhg))
   (setq hb3 (polar hb1 dir HrLengthCont))
   (setq hb4 (polar hb2 dir HrLengthCont))

   (setvar "CLAYER" "A-FLOR-HRAL")
   (command "_LINE" ha4 ha2 ha1 ha3 "")
   (command "_LINE" hb4 hb2 hb1 hb3 "")

   (setq Outer1 s1)
   (setq Outer2 (polar s1 dir (* (- ContRisers 1) tread)))

   (setq Outer3 s6)
   (setq Outer4 (polar s6 dir (* (- ContRisers 1) tread)))

   (command "_LINE" Outer1 Outer2 "")
   (command "_LINE" Outer3 Outer4 "")
   

   (setq HrLength(+ (* 2 HOvhg) (* (- NumberOfSteps 1) tread)))
   (setq RLength (- HrLength HrLengthCont))

   (setq ha1 (polar ha4 dir RLength))
   (setq ha2 (polar ha3 dir RLength))
   (setq hb1 (polar hb4 dir RLength))
   (setq hb2 (polar hb3 dir RLength))

   (setvar "CLAYER" "A-DETL-HIDN")
   (command "_LINE" ha4 ha1 ha2 ha3 "")
   (command "_LINE" hb4 hb1 hb2 hb3 "")

   (setq Outer1 Outer2)
   (setq Outer2 (polar Outer1 dir (- (* NumberOfSteps tread) (* ContRisers tread))))

   (setq Outer3 Outer4)
   (setq Outer4 (polar Outer3 dir (- (* NumberOfSteps tread) (* ContRisers tread))))
   
   (command "_LINE" Outer1 Outer2 "")
   (command "_LINE" Outer3 Outer4 "")
   );Progn

   (progn
   (setq HrLength(+ (* 2 HOvhg) (* (- NumberOfSteps 1) tread)))

   (setq ha1 (polar s4 (+ (dtor 180) dir) HOvhg))
   (setq ha2 (polar s5 (+ (dtor 180) dir) HOvhg))
   (setq ha3 (polar ha1 dir HrLength))
   (setq ha4 (polar ha2 dir HrLength))

   (setq hb1 (polar s2 (+ (dtor 180) dir) HOvhg))
   (setq hb2 (polar s3 (+ (dtor 180) dir) HOvhg))
   (setq hb3 (polar hb1 dir HrLength))
   (setq hb4 (polar hb2 dir HrLength))

   (setvar "CLAYER" "A-DETL-HIDN")
   (command "_LINE" ha4 ha2 ha1 ha3 "CLOSE")
   (command "_LINE" hb4 hb2 hb1 hb3 "CLOSE")

   (setq Outer1 s1)
   (setq Outer2 (polar Outer1 dir (* (- NumberOfSteps 1) tread)))

   (setq Outer3 s6)
   (setq Outer4 (polar Outer3 dir (* (- NumberOfSteps 1) tread)))
   (command "_LINE" Outer1 Outer2 "")
   (command "_LINE" Outer3 Outer4 "")

   );progn
);If
(setq n 1)
(if
   (eq Confirm "Yes")
   (setq Counter 1)
   (setq Counter (getint "\nStair Number starts from:"))
);if
(repeat NumberOfSteps
   (if
   (eq confirm "Yes")
   (progn
(if
(> (* n Rise) 1.2)
(setvar "CLAYER" "A-DETL-HIDN")
(setvar "CLAYER" "A-FLOR-STRS")
);if
   );progn
   (setvar "CLAYER" "A-DETL-HIDN")
   );If

   (command "_LINE" s1 s2 "")
   (command "_LINE" s3 s4 "")
   (command "_LINE" s5 s6 "")
   
   (setq t1pnt (MidOf S3 S4))
   (setq ip (MidOf s3 s4))
   (setq txtht (getvar "TEXTSIZE"))
   (setq txt (itoa Counter))
   (entmake (list '(0 . "TEXT") '(8 . "A-ANNO-TEXT") '(7 . "Annotative - Note" ) (cons 1 txt) (cons 10 t1pnt)(cons 40 txtht)))
   (setq txtobj (vlax-ename->vla-object (entlast)))
   (setq RealVal (/ (vlax-get-property txtobj "Height") (getvar "CANNOSCALEVALUE")))
   (vlax-put-property txtobj "Height" RealVal)
   (command "CHPROP" "L" "" "A" "Y" "")
   (setq s1 (polar s1 dir tread))
   (setq s2 (polar s2 dir tread))
   (setq s3 (polar s3 dir tread))
   (setq s4 (polar s4 dir tread))
   (setq s5 (polar s5 dir tread))
   (setq s6 (polar s6 dir tread))
   (setq n (1+ n))
   (setq Counter (1+ Counter))
);Repeat
(if
   (eq confirm "Yes")
   (setvar "CLAYER" "A-FLOR-HRAL")
   (setvar "CLAYER" "A-DETL-HIDN")
);if

(setvar "CLAYER" CURRENTLAYER)
(setvar "OSMODE" OSM)
);Function


(defun Getper (ang)
(+ (dtor 90) ang)
)

(defun dtor (degree)
(* 0.0174532925 degree)
)

(defun Round (Value)
(if
   (>= (- Value (fix Value)) 0.5)
   (1+ (fix Value))
   (fix Value)
)
)

(defun MidOf(p1 p2)
(polar p1 (angle p1 p2) (/ (distance p1 p2) 2))
)

(defun rtod (r)
(* r 57.2957795)
)

页: 1 [2]
查看完整版本: 按选择集名称选择,