Author Topic: help with a lisp  (Read 1049 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Guest
help with a lisp
« on: June 30, 2021, 12:47:29 PM »
Hi i am using this lisp code to hatch buildings , but sudenly stop and dont work in my Autocad 2020 and i don't know why. Can any one help?

Code - Auto/Visual Lisp: [Select]
  1. (defun c:DIAGRAMMISH ()
  2. (COMMAND "_layer" "_m" "HATCH" "_c" "171" "" "_lw" "0.15" "" "")
  3.  (setq scl (getvar "useri1"))
  4.    (if (= SCL nil)(setq SCL 200))
  5.   (if (> SCL 1000.0)(setq SCL 1000))
  6.   (print "")
  7.   (print "")
  8.   (setq d (getreal "set <0.50> :"))
  9.     (if (= d nil)(setq platos 0.50))
  10.   (if (/= d nil)(setq platos d))
  11.     (setq kl (- (/ SCL 1000.00)(/ (expt SCL 1.2) 12000.00)))
  12.     (print "")
  13.   (setq str (getstring "(Left) /  (Right)] <L> :"))
  14.   (print "")
  15.   (if (= str "")(setq genet 1))
  16.   (if (= str "L")(setq genet 1))
  17.   (if (= str "Left")(setq genet 1))
  18.   (if (= str "R")(setq genet -1))
  19.   (if (= str "Right")(setq genet -1))
  20.  
  21.   (print "")
  22.   (setq s1 (getpoint "first point :"))
  23.   (setq sa s1)
  24.   (setq lista nil)
  25.   (setq lista (append lista sa))
  26.   (setq xxa (car sa))
  27.   (setq yya (cadr sa)) 
  28.   (print "")
  29.   (WHILE (setq s2 (getpoint s1 " next point :"))
  30.          (setq s1 s2)
  31.          (if (/= s2 nil)(setq lista (append lista s2)))
  32.          (if (/= s2 nil)(setq st s2))
  33.          (print "")
  34.          )
  35. (setq xxt (car st))
  36. (setq yyt (cadr st))   
  37. (setq mhkos (length lista))
  38. (setq xa (nth 0 lista))
  39. (setq ya (nth 1 lista))
  40. (setq xb (nth 3 lista))
  41. (setq yb (nth 4 lista))
  42. (setq xv (nth (- mhkos 6) lista))
  43. (setq yv (nth (- mhkos 5) lista))
  44. (setq xz (nth (- mhkos 3) lista))
  45. (setq yz (nth (- mhkos 2) lista))
  46. (setq ssa (list xa ya 0))
  47. (setq ssb (list xb yb 0))
  48. (setq ssv (list xv yv 0))
  49. (setq ssz (list xz yz 0))
  50. (setq fa (angle ssb ssa))
  51. (setq ft (angle ssv ssz))
  52. (setq so (polar sa fa 100))
  53. (setq sz (polar st ft 100))
  54. (setq sn (list xv yv 0))
  55. (setq sd (list xb yb 0))
  56.  (setq diafora (+ (- xxa xxt)( - yya yyt)))
  57.   (setq krithrio (abs diafora))
  58. (if (< krithrio 0.01)(setq lista (append sn lista)))
  59. (if (< krithrio 0.01)(setq lista (append lista sd)))
  60. (if (> krithrio 0.01)(setq lista (append so lista)))
  61. (if (> krithrio 0.01)(setq lista (append lista sz)))
  62.  
  63.  
  64. (setq mhkos (length lista))
  65. (setq arshm (/ (- mhkos 6) 3))
  66. (setq number 0)
  67. (setq vv 1)  
  68. (SETQ OS (GETVAR "OSMODE"))
  69. (SETVAR "OSMODE" 0)
  70.    
  71. (repeat (- arshm 1)
  72. (setq number (+ number 1))
  73. (setq vv (* vv -1))  
  74.  (command "linetype" "s" "bylayer" "")
  75.  
  76. (setq xp (nth (+ (* number 3) -3) lista))  
  77. (setq yp (nth (+ (* number 3) -2) lista))
  78. (setq zp (nth (+ (* number 3) -1) lista))
  79. (setq sp (list xp yp zp))
  80.  
  81. (setq xo (nth (+ (* number 3) 0) lista))  
  82. (setq yo (nth (+ (* number 3) 1) lista))
  83. (setq zo (nth (+ (* number 3) 2) lista))
  84. (setq so (list xo yo zo))
  85.  
  86. (setq xe (nth (+ (* number 3) 3) lista))  
  87. (setq ye (nth (+ (* number 3) 4) lista))
  88. (setq ze (nth (+ (* number 3) 5) lista))
  89. (setq se (list xe ye ze))
  90.  
  91. (setq xm (nth (+ (* number 3) 6) lista))  
  92. (setq ym (nth (+ (* number 3) 7) lista))
  93. (setq zm (nth (+ (* number 3) 8) lista))
  94. (setq sm (list xm ym zm))  
  95.  
  96. (setq f1 (angle so sp))
  97. (setq f2 (angle so se))
  98. (setq v1 (angle se so))
  99. (setq v2 (angle se sm))
  100.  
  101. (setq gonia1 (/ (+ f1 f2) 2))  
  102. (setq gonia2 (/ (+ v1 v2) 2))
  103.    
  104. ;left hatch
  105.  
  106. (setq d1 0)
  107. (setq d2 (* genet platos))
  108.  
  109. (setq sin1 (/ ( - f2 f1) 2))
  110. (setq la1 0)  
  111. (if (/= sin1 0)(setq la1 (/ d1 (sin sin1))))
  112. (setq soo (polar so gonia1 la1))
  113. (setq sin2 (/ ( - v2 v1) 2))
  114. (setq la2 0)  
  115. (if (/= sin2 0)(setq la2 (/ d1 (sin sin2))))
  116. (setq see (polar se gonia2 la2))
  117.  
  118. (setq ns1 soo)
  119. (setq ns2 see)
  120.  
  121. (setq sin1 (/ ( - f2 f1) 2))
  122. (setq la1 0)  
  123. (if (/= sin1 0)(setq la1 (/ d2 (sin sin1))))
  124. (setq sso (polar ns1 gonia1 la1))
  125. (setq sin2 (/ ( - v2 v1) 2))
  126. (setq la2 0)  
  127. (if (/= sin2 0)(setq la2 (/ d2 (sin sin2))))
  128. (setq sse (polar ns2 gonia2 la2))
  129.  
  130.  (setq gv (+ (* vv 45) (/ (* f2 180) 3.1415926)))
  131.  
  132. (COMMAND "HATCH" "LINE" kl gv "" "N" ns1 ns2 sse sso "close" "")
  133.   )
  134.    
  135.  (SETVAR "OSMODE" OS)
  136.  (command "linetype" "s" "bylayer" "")
  137.  (command "setvar" "clayer" "0")
  138.   )  
  139.  
  140. [/code


Thanks

CodeDing

  • Newt
  • Posts: 50
Re: help with a lisp
« Reply #1 on: June 30, 2021, 02:00:32 PM »
PM,

What does the command history say when you run it? can you post it please?

Best,
~DD
~DD
Senior CAD Tech & AI Specialist
Need AutoLisp help?
Try my custom GPT 'AutoLISP Ace'

PM

  • Guest
Re: help with a lisp
« Reply #2 on: June 30, 2021, 03:46:42 PM »
the command run but not create hatch. Before the problem i run the command use as default the 0.50 offset pick the points and create a hatch with Hatch scale  0.125. Now is not create the hatch and ask me to select object !!!!!! i can not understand what happend. I didn't change anything in this code

Lonnie

  • Newt
  • Posts: 169
Re: help with a lisp
« Reply #3 on: June 30, 2021, 05:05:29 PM »
If your pattern is too dense you may have to change your maxhatch env. 
(setenv "MaxHatch" "1000000")
Something like that.

CodeDing

  • Newt
  • Posts: 50
Re: help with a lisp
« Reply #4 on: June 30, 2021, 05:20:51 PM »

Can you post your Command History when you run the command please.. That would provide some useful insight.

I've tried to run your command a handful of times and do not understand how your command works. I don't want to read your code Line-By-Line to understand it.

Please post the command history.
~DD
Senior CAD Tech & AI Specialist
Need AutoLisp help?
Try my custom GPT 'AutoLISP Ace'

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: help with a lisp
« Reply #5 on: July 01, 2021, 10:37:15 PM »
Try this will need a couple of changes like offset value and hatch settings, supports the boundary is on more than 1 layer eg sides & back  may be different to front.

Code: [Select]
; hatch a strip inside a closed area
; By AlanH July 2021

(defun c:hatstrip ( / off ss lays x pt pt2 ent1 ent2 co-ord oldsnap oldlay)
(setq off 1.0
oldsnap (getvar 'osmode)
oldlay (getvar 'clayer))

(if (not (tblsearch "Layer" "HATCH"))
(COMMAND "_layer" "_m" "HATCH" "_c" "171" "" "_lw" "0.15" "" "")
)

(prompt "\nPick objects for outside 1 is ok more for multi layer ")

(if (setq ss (ssget))
(progn
(command "layiso" ss "")

(setvar 'osmode 0)

(setq pt (getpoint "\nPlease pick point inside"))
(command "bpoly" pt "")
(setq ent1 (entlast))
(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast)))))
(setq pt2 (polar (nth 0 co-ord) (angle (nth 0 co-ord) pt) (/ off 2.0)))

(command "offset" 10.0 ent1 pt "")
(setq ent2 (entlast))
(setvar 'Clayer "HATCH")

(command "-hatch" "P" "ANSI31" 1 0 pt2 "")
(command "erase" ent1 ent2 "")
(command "layuniso")
)
)

(setvar 'osmode oldsnap)
(setvar 'clayer oldlay)

(princ)
)

(c:hatstrip)
A man who never made a mistake never made anything