Author Topic: Need a gide to Draw a PLine  (Read 487 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1208
Need a gide to Draw a PLine
« on: October 08, 2017, 06:49:32 am »
Hi all
Could some one gide me how to code a lisp to draw a Pline in insertion point of a block related to an attribute value in sequence
and if duplicate draw any symbol.
Attached a sample
Thanks

Lee Mac

  • Seagull
  • Posts: 11852
  • AutoCAD 2015 Windows 7 London, England
Re: Need a gide to Draw a PLine
« Reply #1 on: October 08, 2017, 07:06:15 am »
  • Obtain a selection set of the target attributed blocks
  • Iterate over the selection:
    • Retrieve the block insertion point
    • Retrieve the appropriate attribute values
    • Construct an association list containing the attribute values paired with the insertion point
  • Sort the association list by the attribute values
  • Construct a polyline with vertices located at the points in the sorted list

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #2 on: October 09, 2017, 09:53:56 am »
Thanks LEE

Needed sorting in sequence

this part not working well this is for check if duplicate 
Code - Auto/Visual Lisp: [Select]
  1.  (setq blkpnt1 (nth 0 (nth sr lsts )))
  2.  (setq blkatt1 (nth 1 (nth sr lsts )))
  3.  (if (setq srr (1+ sr))
  4.    (progn
  5.      (setq blkpnt2 (nth 0 (nth (1+ sr) lsts )))
  6.      (setq blkatt2 (nth 1 (nth (1+ sr) lsts )))
  7.      ))
  8.  (if (eq blkatt1 blkatt2)
  9.    (progn
  10.      (setq crc (vla-AddCircle spc (vlax-3d-point (trans blkpnt2 1 0)) 1000))
  11.      (vla-put-layer crc "Defpoints")
  12.      (vla-put-color crc 256)
  13.      (setq sr (+ 2 sr))
  14.      )
  15.    (progn
  16.      (setq pnts (cons blkpnt1 pnts))
  17.      (setq sr (1+ sr))
  18.      ))

full code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:RmN ( / ATT BLKATT1 BLKATT2 BLKNM BLKPNT1 BLKPNT2 CRC DOC ENT I IP LSTS NM OBJ OBJDATA OBJVL P1 P2 PNT PNTS S SPC SR SRR SS TG  )
  2.  
  3.  (setq blknm "CAP-RMN-ALL")
  4.  (setq tg "RN")
  5.  (setq lsts nil)
  6.  (setq pnts nil)
  7.  (if (and
  8. (setq p1 (getpoint "\nSelect blocks: "))
  9. (setq p2 (getcorner p1 "\nSelect blocks: "))
  10. (setq ss (ssget "_C" p1 p2 '((0 . "INSERT" ) (66 . 1))))
  11. )
  12.    (progn
  13.      (setq pnts (list p2))
  14.    (repeat (setq i (sslength ss))
  15.      (setq ent (entget (setq obj (ssname ss (setq i (1- i))))))
  16.      (if (eq blknm (setq nm (LM:name->effectivename (cdr (assoc 2 ent)))))
  17.  (setq objVL (vlax-ename->vla-object obj))
  18.  (setq ip (vlax-SafeArray->List (vlax-Variant-Value ip)))
  19.  (setq att (LM:vl-getattributevalue objVL tg))
  20.  (setq objdata (list ip att))
  21.  (setq lsts (cons objdata lsts))
  22.  ))
  23.      )))
  24.  
  25.  ; lsts in sequence
  26.  
  27.  (if (and
  28. (< 0 (setq s (length lsts)))
  29. (setq sr 0)
  30. )
  31. (repeat s
  32.  (setq blkpnt1 (nth 0 (nth sr lsts )))
  33.  (setq blkatt1 (nth 1 (nth sr lsts )))
  34.  (if (setq srr (1+ sr))
  35.    (progn
  36.      (setq blkpnt2 (nth 0 (nth (1+ sr) lsts )))
  37.      (setq blkatt2 (nth 1 (nth (1+ sr) lsts )))
  38.      ))
  39.  (if (eq blkatt1 blkatt2)
  40.    (progn
  41.      (setq crc (vla-AddCircle spc (vlax-3d-point (trans blkpnt2 1 0)) 1000))
  42.      (vla-put-layer crc "Defpoints")
  43.      (vla-put-color crc 256)
  44.      (setq sr (+ 2 sr))
  45.      )
  46.    (progn
  47.      (setq pnts (cons blkpnt1 pnts))
  48.      (setq sr (1+ sr))
  49.      ))
  50.  (setq pnts (apply 'append pnts))
  51.  (setq pnt (vlax-make-safearray vlax-vbDouble (cons 0 (- (length pnts) 1))))
  52.  (vlax-safearray-fill pnt pnts)
  53.  (setq obj (vla-addPolyline spc pnt))
  54.  (vla-put-layer obj "Defpoints")
  55.  (vla-put-color OBJ 256)
  56.  )))
  57.  
  58. ;; Block Name -> Effective Block Name  -  Lee Mac
  59. ;; blk - [str] Block name
  60. (defun LM:name->effectivename (blk / rep)
  61.  (if (and (wcmatch blk "`**")
  62.   (setq
  63.     rep (cdadr
  64.   (assoc
  65.     -3
  66.     (entget
  67.       (cdr (assoc 330 (entget (tblobjname "block" blk))))
  68.       '("AcDbBlockRepBTag")
  69.     )
  70.   )
  71. )
  72.   )
  73.   (setq rep (handent (cdr (assoc 1005 rep))))
  74.      )
  75.    (cdr (assoc 2 (entget rep)))
  76.    blk
  77.  )
  78. ) (princ)
  79.  
  80. ;; Get Attribute Value  -  Lee Mac
  81. ;; Returns the value held by the specified tag within the supplied block, if present.
  82. ;; blk - [vla] VLA Block Reference Object
  83. ;; tag - [str] Attribute TagString
  84. ;; Returns: [str] Attribute value, else nil if tag is not found.
  85. (defun LM:vl-getattributevalue (blk tag)
  86.  (setq tag (strcase tag))
  87.  (vl-some '(lambda (att)
  88.      (if (= tag (strcase (vla-get-tagstring att)))
  89.      )
  90.    )
  91.   (vlax-invoke blk 'getattributes)
  92.  )
  93. )

Lee Mac

  • Seagull
  • Posts: 11852
  • AutoCAD 2015 Windows 7 London, England
Re: Need a gide to Draw a PLine
« Reply #3 on: October 09, 2017, 01:36:04 pm »
Great start Hasan, well done!

Here's a nudge in the right direction - I would suggest testing for duplicates whilst acquiring the initial dataset, this saves an iteration of the dataset and avoids problems when sorting:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:rmn ( / blk ent enx idx lst sel tag val )
  2.    (setq blk "CAP-RMN-ALL"
  3.          tag "RN"
  4.    )
  5.    (if (setq sel (ssget (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," blk)))))
  6.        (progn
  7.            (repeat (setq idx (sslength sel))
  8.                (setq idx (1- idx)
  9.                      ent (ssname sel idx)
  10.                      enx (entget ent)
  11.                )
  12.                (if (and (= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
  13.                         (setq val (LM:getattributevalue ent tag))
  14.                         (setq val (atoi val))
  15.                    )
  16.                    (if (assoc val lst)
  17.                        (entmake (list '(0 . "CIRCLE") (assoc 10 enx) '(40 . 1000.0) '(8 . "Defpoints") '(62 . 256)))
  18.                        (setq lst (cons (cons val (assoc 10 enx)) lst))
  19.                    )
  20.                )
  21.            )
  22.            (entmake
  23.                (append
  24.                    (list
  25.                       '(000 . "LWPOLYLINE")
  26.                       '(100 . "AcDbEntity")
  27.                       '(100 . "AcDbPolyline")
  28.                       '(008 . "Defpoints")
  29.                       '(062 . 256)
  30.                        (cons 90 (length lst))
  31.                       '(070 . 0)
  32.                    )
  33.                    (mapcar 'cdr (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))
  34.                )
  35.            )
  36.        )
  37.    )
  38.    (princ)
  39. )
  40.  
  41. ;; Get Attribute Value  -  Lee Mac
  42. ;; Returns the value held by the specified tag within the supplied block, if present.
  43. ;; blk - [ent] Block (Insert) Entity Name
  44. ;; tag - [str] Attribute TagString
  45. ;; Returns: [str] Attribute value, else nil if tag is not found.
  46.  
  47. (defun LM:getattributevalue ( blk tag / enx )
  48.    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
  49.        (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
  50.            (cdr (assoc 1 (reverse enx)))
  51.            (LM:getattributevalue blk tag)
  52.        )
  53.    )
  54. )
  55.  
  56. ;; Block Name -> Effective Block Name  -  Lee Mac
  57. ;; blk - [str] Block name
  58.  
  59. (defun LM:name->effectivename ( blk / rep )
  60.    (if
  61.        (and (wcmatch blk "`**")
  62.            (setq rep
  63.                (cdadr
  64.                    (assoc -3
  65.                        (entget
  66.                            (cdr (assoc 330 (entget (tblobjname "block" blk))))
  67.                           '("AcDbBlockRepBTag")
  68.                        )
  69.                    )
  70.                )
  71.            )
  72.            (setq rep (handent (cdr (assoc 1005 rep))))
  73.        )
  74.        (cdr (assoc 2 (entget rep)))
  75.        blk
  76.    )
  77. )
  78.  

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #4 on: October 09, 2017, 02:10:51 pm »
It is very good idea

Thanks LEE for help

edit:
By the way, I was creating the selection by points because I want to make these 2 points as a start and eand of the pline.
« Last Edit: October 09, 2017, 02:16:15 pm by HasanCAD »

Lee Mac

  • Seagull
  • Posts: 11852
  • AutoCAD 2015 Windows 7 London, England
Re: Need a gide to Draw a PLine
« Reply #5 on: October 09, 2017, 02:43:06 pm »
It is very good idea

Thanks LEE for help

edit:
By the way, I was creating the selection by points because I want to make these 2 points as a start and eand of the pline.

You're most welcome Hasan - I have confidence that you can modify the code from here  :-)

Tharwat

  • Bull Frog
  • Posts: 500
  • Hypersensitive
Re: Need a gide to Draw a PLine
« Reply #6 on: October 09, 2017, 02:54:38 pm »
Hi,
One selection creates one polyine with zero length.  :grinwink:

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #7 on: October 11, 2017, 02:29:16 am »
...
You're most welcome Hasan - I have confidence that you can modify the code from here  :-)
Thanks for the first push, I'll modify to match my needs.
« Last Edit: October 11, 2017, 03:03:30 am by HasanCAD »

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #8 on: October 11, 2017, 02:31:11 am »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

Tharwat

  • Bull Frog
  • Posts: 500
  • Hypersensitive
Re: Need a gide to Draw a PLine
« Reply #9 on: October 11, 2017, 02:44:39 am »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

No problem,
Just for clarifications. I am not picking up the codes rather than trying to pay attention to one important issue of the posted codes.

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #10 on: October 11, 2017, 07:20:26 am »
Hi,
One selection creates one polyine with zero length.  :grinwink:
Thanks Tharwat for your comment.

No problem,
Just for clarifications. I am not picking up the codes rather than trying to pay attention to one important issue of the posted codes.

Ofcource
and your value comments are appreciated.

Thanks Thaewat

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #11 on: October 12, 2017, 05:57:20 am »
This is what I ended up to
but this line gives nil
Code - Auto/Visual Lisp: [Select]
  1. (= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
Code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:RoomNameLink ( / blk ent enx idx lst lst2 sel tag val p1 p2 strt lstl)
  2.  
  3.    (if (and
  4.  (setq att (car (nentsel "\nSelect attribute: ")))
  5.  (= "ATTRIB" (cdr (assoc 0 (entget att))))
  6.  (setq tag (cdr (assoc 2 (entget att))))
  7.  (setq attobj (vlax-ename->vla-object att))
  8.  (setq blkobj (cdr (assoc 330 (entget att))))
  9.  (setq blk (cdr (assoc 8 (entget blkobj))))
  10.  (setq p1 (getpoint "\nSelect blocks: "))
  11.  (setq p2 (getcorner p1 "\nSelect blocks: "))
  12.  (setq sel (ssget "_C" p1 p2 (list '(0 . "INSERT") '(66 . 1) (cons 2 (strcat "`*U*," blk)))))
  13.  )
  14.        (progn
  15.            (repeat (setq idx (sslength sel))
  16.                (setq idx (1- idx)
  17.                      ent (ssname sel idx)
  18.                      enx (entget ent))
  19.                (if (and ;(= (strcase blk) (strcase (LM:name->effectivename (cdr (assoc 2 enx)))))
  20.                         (setq val (LM:getattributevalue ent tag))
  21.                         (setq val (atoi val)))
  22.                    (if (assoc val lst)
  23.                        (entmake (list '(0 . "CIRCLE") (assoc 10 enx) '(40 . 1000.0) '(8 . "Defpoints") '(62 . 256)))
  24.                        (setq lst (cons (cons val (assoc 10 enx)) lst))
  25.                    )))
  26.  (if (< 1 (setq lstl (length lst)))
  27.    (progn
  28.    (setq lst (vl-sort lst '(lambda ( a b ) (< (car a) (car b)))))
  29.    (setq p2 (cons (1- (nth 0 (nth 0 lst))) (cons 10 p2)))
  30.            (entmake
  31.                (append
  32.                    (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(008 . "Defpoints") '(062 . 256)
  33.  (cons 90 (1+ lstl)) '(070 . 0))
  34.                    (mapcar 'cdr (cons p2 lst))
  35.                )))))) (princ))
  36.  
  37. ;; Get Attribute Value  -  Lee Mac
  38. ;; Returns the value held by the specified tag within the supplied block, if present.
  39. ;; blk - [ent] Block (Insert) Entity Name
  40. ;; tag - [str] Attribute TagString
  41. ;; Returns: [str] Attribute value, else nil if tag is not found.
  42. (defun LM:getattributevalue ( blk tag / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (cdr (assoc 1 (reverse enx))) (LM:getattributevalue blk tag))))
  43.  
  44. ;; Block Name -> Effective Block Name  -  Lee Mac
  45. ;; blk - [str] Block name
  46. (defun LM:name->effectivename ( blk / rep ) (if (and (wcmatch blk "`**") (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag"))))) (setq rep (handent (cdr (assoc 1005 rep))))) (cdr (assoc 2 (entget rep))) blk)) (princ)
« Last Edit: October 12, 2017, 08:38:30 am by HasanCAD »

Lee Mac

  • Seagull
  • Posts: 11852
  • AutoCAD 2015 Windows 7 London, England
Re: Need a gide to Draw a PLine
« Reply #12 on: October 12, 2017, 12:42:14 pm »
Code: [Select]
(setq blk (cdr (assoc 8 (entget blkobj))))
Your 'blk' variable is currently storing the layer name of the block, not the block name.

HasanCAD

  • Swamp Rat
  • Posts: 1208
Re: Need a gide to Draw a PLine
« Reply #13 on: October 15, 2017, 04:51:20 am »
Code: [Select]
(setq blk (cdr (assoc 8 (entget blkobj))))
Your 'blk' variable is currently storing the layer name of the block, not the block name.


 :oops: :oops: :oops: