Author Topic: Is it possible to help the code ؟  (Read 310 times)

0 Members and 1 Guest are viewing this topic.

HOSNEYALAA

  • Mosquito
  • Posts: 19
Is it possible to help the code ؟
« on: November 24, 2018, 02:35:25 PM »
Hello all

I have code to draw a perville depending on points
But do not complete a rectangular drawing around the resulting text
Is it possible to help?

Code - Auto/Visual Lisp: [Select]
  1. (DEFUN c:xx (/ AA DX DX2 DY DY2 END1 END2 GRADE I LEN MID MIX MIY P PTX PTXY PTY PTYY PX PY SLOPE XL1 XL2 XM YL1 YL11 YL2 YM A HT MIX1 MIX2 MIX22 MIY1 MIY2 MIY22 N PT PTX1 YL111 II LL LR NA NAA NPTXY NPTYY NPX NPX1 NPY SS SSN TB TEXTENT UL UR X III)
  2.  (SETVAR "CECOLOR" "RGB:147,149,152")
  3.  (SETVAR "OSMODE" 35)
  4.  (INITGET 7)
  5.  (COMMAND "PDMODE" 35)
  6.  (COMMAND "PDSIZE" 1)
  7.  (SETQ ht (GETREAL "\n-> Enter text height : "))
  8.  (SETQ p(GETPOINT "\n-> Choose the starting profile:"))
  9.  (SETQ pX(CAR P));POINT-X OF BEIGING PROFILE
  10.  (SETQ pY(CADR P));POINT-Y OF BEIGING PROFILE
  11.  (SETQ n 0)
  12.  (command "-osnap" "endpoint,midpoint,center,node,quadrant,tangent,INTersection,PERpendicular")
  13.  (WHILE
  14.    (SETQ pT (GETPOINT "\n-> Choose points for drawing:"))
  15.    (SETQ n (1+ n))
  16.  
  17.    (SETQ pTX(CAR PT));X__point TO DRAWING
  18.    (SETQ pTY(CADDR PT));Y__point TO DRAWING
  19.    (setq PTXY (list PTX PTY))
  20.  
  21.    (SETQ A(CONS pTXY A))
  22. ;;;    (COMMAND "_.POINT" pTXY "")
  23. ;;;    (setq PTYY (rtos (CADDR PT)))
  24. ;;;    (command "text" "j" "ML" PTXY (/ HT 3) 90 PTYY)
  25. ;;;    (command "._Change" (entlast) "" "p" "color" "80" "")
  26.    (princ A)
  27.  );WHILE
  28.  (SETQ AA(reverse A))
  29.  
  30.   (setq II 0) ; Order of  Line
  31. (while (AND (< II N ) (/= II N))
  32.  
  33. (setq END1 (NTH 0 AA)) ; Get Start Point OF Line
  34. (setq END2 (NTH II AA)) ; Get End Point OF Line
  35. (setq XL1 (car END1)) ; Get X cordinate for START POINT.
  36. (setq YL1 (cadr END1)) ; Get Y cordinate for START POINT.
  37. (setq XL2 (car END2)) ; Get X cordinate for END POINT.
  38. (setq YL2 (cadr END2)) ; Get Y cordinate for END POINT.
  39. (setq NpX (+ pX (- XL2 XL1)));Difference between points(X-X)
  40. (setq NpX1 (+ 1 NPX))
  41.  
  42. (setq NpY (+ pY (- YL2 YL1)));Difference between points(Y-Y)
  43.  
  44.        (setq NPTXY (list NpX NpY))
  45.        (SETQ NA(CONS NPTXY NA))
  46.  
  47. (COMMAND "_.POINT" NPTXY "")
  48. (setq NPTYY (rtos YL2))
  49. (command "text" "j" "ML" NPTXY (/ HT 3) 90 NPTYY)
  50. (command "._Change" (entlast) "" "p" "color" "80" "")
  51.  
  52.  (setq II (+ II 1))
  53. );while
  54.  
  55. (SETQ NAA(reverse NA))
  56.  
  57.    (command "-osnap" "tangent")
  58.  
  59.        (setq I 0) ; Order of  Line
  60. (while (AND (< I N ) (/= I N))
  61.  
  62. (setq END1 (NTH I NAA)) ; Get Start Point OF Line
  63. (setq END2 (NTH (+ 1 I) NAA)) ; Get End Point OF Line
  64. (setq XL1 (car END1)) ; Get X cordinate for START POINT.
  65. (setq YL1 (cadr END1)) ; Get Y cordinate for START POINT.
  66. (setq YL11 (cadr (NTH 0 NAA))); Get X cordinate for END POINT-1
  67. (setq YL111 (- YL11 1)); Get X cordinate for END POINT
  68. (setq XL2 (car END2)) ; Get (X-1) cordinate for END POINT-1.
  69. (setq YL2 (cadr END2)) ; Get Y cordinate for END POINT.
  70. (setq XM (+ XL1 (/ (- XL2 XL1) 2)))
  71. (setq YM (+ YL1 (/ (- YL2 YL1) 2)))
  72. (setq MID (list XM YM))
  73.  (setq MIx (list NpX YL1));POINT OF AXISS X
  74.  (setq MIy (list XL2 YL11));POINT OF AXISS Y
  75.  
  76.  (setq MIX1 (list XL1 YL11));DIMENSION POINT X1
  77.  (setq MIx2 (list XL2 YL11));DIMENSION POINT X2
  78.  (setq MIx22 (list XL2 YL111));DIMENSION POINT X3
  79.         (command "DIMLINEAR" MIX1 MIx2 MIx22)
  80.  (command "._Change" (entlast) "" "p" "color" "130" "")
  81.  
  82. (setq MIy1 (list NpX YL1));DIMENSION POINT Y1
  83. (setq MIy2 (list NpX YL2));DIMENSION POINT Y2
  84. (setq MIy22 (list NpX1 YL2));DIMENSION POINT Y3
  85. (command "DIMLINEAR" MIy1 MIy2 MIy22)
  86. (command "._Change" (entlast) "" "p" "color" "130" "")  
  87.  
  88. (setq dx (- XL1 XL2)) (SETQ dx2 (* dx dx))
  89. (setq dy (- YL1 YL2)) (SETQ dy2 (* dy dy))
  90. (SETQ SLOPE (RTOS (* (/ (/ DY 10.0) DX) 10.0) 2 2))
  91. (SETQ GRADE (RTOS (* (/ (/ DX ) DY)) 2 2))
  92. (command "text" "j" "ML" MID (/ HT 3) 90 (strcat "1:"GRADE))
  93.        (command "._Change" (entlast) "" "p" "color" "240" "")
  94. (setq len (sqrt(ABS(+ dx2 dy2))))
  95. (command "lwdisplay" "on")
  96. (command "pline" END1 END2 "")
  97.  (command "._Change" (entlast) "" "p" "color" "140" "")
  98.  (command "._Change" (entlast) "" "p" "lweight" ".5" "")
  99. (command "line" END1 MIX "")
  100.  (command "._Change" (entlast) "" "p" "color" "41" "")
  101.  (command "._Change" (entlast) "" "p" "ltype" "DASHED2" "")
  102.        (command "line" END2 MIY "")
  103.  (command "._Change" (entlast) "" "p" "color" "41" "")
  104.  (command "._Change" (entlast) "" "p" "ltype" "DASHED2" "")
  105.  
  106.  
  107.  (setq I (+ I 1))
  108. );while
  109.  
  110.  (setq ss (ssget "X" '((0 . "TEXT"))))
  111.    (if (/= SS nil)
  112.    (progn
  113.  (repeat (setq III (sslength Ss))
  114.  (setq textent (ssname ss (setq III (1- III))))
  115.   (command "ucs" "Object" textent)
  116.  (setq tb (textbox (list  (cons -1 textent))))
  117.       (setq ll (car tb))
  118.       (setq ur  (cadr tb))
  119.       (setq ul  (list (car ll) (cadr ur)))
  120.       (setq lr (list (car ur) (cadr ll)))
  121.  
  122.  (command "pline" ll lr ur ul "Close")
  123.  (command "ucs" "p")
  124.    );REAPET
  125.  );PROGN
  126.  );IF
  127.  (princ)
  128.  
  129.  
  130. );defun
  131.  

Revised kdub : Code Tags added : refer :- http://www.theswamp.org/index.php?topic=48309.0
« Last Edit: November 24, 2018, 06:23:15 PM by kdub »

kdub

  • SuperMod
  • Swamp Rat
  • Posts: 1138
  • class keyThumper<T>:ILazy<T>
Re: Is it possible to help the code ؟
« Reply #1 on: November 24, 2018, 06:25:38 PM »
Are you able to add the box around text manually ?
If so, how would you do it ?

//=============
For notes regarding code posting refer :
http://www.theswamp.org/index.php?topic=48309.0


called Kerry in my other life

Sometimes the question is more important than the answer.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10324
Re: Is it possible to help the code ؟
« Reply #2 on: November 25, 2018, 10:07:32 AM »
I've reached the age where the happy hour is a nap. ()
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Crank

  • Swamp Rat
  • Posts: 1431
Re: Is it possible to help the code ؟
« Reply #3 on: November 25, 2018, 03:14:40 PM »
Perhaps use mtext?
Code: [Select]
;(command "text" "j" "ML" NPTXY (/ HT 3) 90 NPTYY)
;(command "._Change" (entlast) "" "p" "color" "80" "")
(command-s "._mtext" NPTXY "j" "ml" "r" 90 "h" (/ HT 3) "w" 0 NPTYY "")
(entmod (append (entget (entlast)) (list '(90 . 16) '(63 . 256) '(45 . 1.5) '(441 . 0)))); 1.5 = offset distance of the border
(command-s "._CHPROP" (entlast) "" "c" 80 ""); or add '(62 . 80) to the list in the previous line of code
If you don't want to use MTEXT, then you can explode it and the result will be a 'text + lwpolyline'.
« Last Edit: December 02, 2018, 12:14:09 PM by Crank »

 Vault Professional 2018   /   Building Design Suite Ultimate 2017  /  AEC Collection 2018+2019   /   Acad Qubit

HOSNEYALAA

  • Mosquito
  • Posts: 19
Re: Is it possible to help the code ؟
« Reply #4 on: December 03, 2018, 12:18:37 AM »
thank you all