Author Topic: Fresh eyes needed to check whats wrong  (Read 2212 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1421
Fresh eyes needed to check whats wrong
« on: January 29, 2015, 07:58:47 AM »
We draft structural drawings a step of work is checking the columns size (its drawn as rectangle or circle)
I coded this rough routine to insert a text containing width and height of each rectangle.
but the text insertion point is the same

Code: [Select]
(defun c:ColumnsSizes () (c:CSZ))
(defun c:CSZ (/ a b l1 l2 mn mx peditaccept plinecnt pnt1 pnt1x pnt1y pnt2 pnt2x pnt2y points ss xmax xmin ymax ymin)
  (vl-load-com)

  (if ;(setq ss (ssget "_X" '((0 . "ARC,LINE"))))
    (setq ss (ssget "_X" '((0 . "ARC,LINE,LWPOLYLINE"))))
    (progn
      (setq peditaccept (getvar 'peditaccept))
      (setvar 'peditaccept 1)
      (command "_.pedit" "_M" ss "" "_J" "" "")
      (setvar 'peditaccept peditaccept)
      )
    )
 
  (setq plinecnt 0)
  (if (setq ss (ssget "_X"))
    (repeat (sslength ss)
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss plinecnt)) 'mn 'mx)
      (setq mnm (cons (vlax-safearray->list mn) mnm))
      (setq mxm (cons (vlax-safearray->list mx) mxm))
      (setq points (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list mnm mxm)))
      (setq pntn (nth 0 Points))
      (setq pntx (nth 1 Points))
      (setq pntnX (nth 0 pntn))      (setq pntnY (nth 1 pntn))
      (setq pntxX (nth 0 pntx))      (setq pntxY (nth 1 pntx))
      (InsText (strcat "Size" (rtos (round (- pntxX pntnX) 1)) " x " (rtos (round (- pntxY pntnY) 1))) (list pntxX pntnY 0.0))
      (setq plinecnt (1+ plinecnt))
      )
    )
  )

(princ)
(princ "\n      q_|_|| _\\|| q_|| _\\|" )
(princ "\n  Type  CSZ  to invoke the lisp " )

(defun round (number by) (if (zerop by) number (+ (* (fix (/ number (setq by (abs by)))) by) (if (< (* 0.5 by) (rem number by)) by 0))))

(defun InsText ( BlkName pt / )
  (entmakex (list
      (cons 0  "TEXT")
      (cons 8  "Defpoints")
      (cons 1  BlkName)
      (cons 10 Pt)
      (cons 40 100)
      (cons 41 0.8)
      )))
« Last Edit: January 29, 2015, 08:02:11 AM by HasanCAD »

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Fresh eyes needed to check whats wrong
« Reply #1 on: January 29, 2015, 08:26:28 AM »
1.
Filter here: (setq ss (ssget "_X"))

2.
Your are dumping bounding points in two lists and then calculate dimensions, and insertion points from the min and max points in those lists. Both the dimensions and insertion points are therefore wrong.

HasanCAD

  • Swamp Rat
  • Posts: 1421
Re: Fresh eyes needed to check whats wrong
« Reply #2 on: January 29, 2015, 09:19:41 AM »
1.
Filter here: (setq ss (ssget "_X"))
I want to select all object. Wha ts wrong with this filter?


2.
Your are dumping bounding points in two lists and then calculate dimensions, and insertion points from the min and max points in those lists. Both the dimensions and insertion points are therefore wrong.
I noteced that when run line by line, I belive that I do not know how to deal with vlax-safearray->list

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Fresh eyes needed to check whats wrong
« Reply #3 on: January 29, 2015, 11:12:00 AM »
I would add a filter just in case a user applies the function twice.

Judging by the number of unused variables and unnecessary code, I think you have pasted sections from an existing function...

The code below works. But there is an important limitation. The dimensions for rectangular columns that are not orthogonal will be wrong.

Code: [Select]
(defun c:ColumnsSizes () (c:CSZ))
(defun c:CSZ ( / mn mx peditaccept plinecnt pntnX pntxX ss)
  (vl-load-com)

  (if ;(setq ss (ssget "_X" '((0 . "ARC,LINE"))))
    (setq ss (ssget "_X" '((0 . "ARC,LINE,LWPOLYLINE"))))
    (progn
      (setq peditaccept (getvar 'peditaccept))
      (setvar 'peditaccept 1)
      (command "_.pedit" "_M" ss "" "_J" "" "")
      (setvar 'peditaccept peditaccept)
    )
  )

  (setq plinecnt 0)
  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
    (repeat (sslength ss)
      (vla-getboundingbox (vlax-ename->vla-object (ssname ss plinecnt)) 'mn 'mx)
      (setq mn (vlax-safearray->list mn))
      (setq mx (vlax-safearray->list mx))
      (setq pntnX (nth 0 mn))  (setq pntnY (nth 1 mn))
      (setq pntxX (nth 0 mx))  (setq pntxY (nth 1 mx))
      (InsText (strcat "Size" (rtos (- pntxX pntnX) 2 1) " x " (rtos (- pntxY pntnY) 2 1)) (list pntxX pntnY 0.0))
      (setq plinecnt (1+ plinecnt))
    )
  )
)

(defun InsText ( BlkName pt / )
  (entmakex
    (list
      (cons 0  "TEXT")
      (cons 8  "Defpoints")
      (cons 1  BlkName)
      (cons 10 Pt)
      (cons 40 100)
      (cons 41 0.8)
    )
  )
)

(princ "\n  Type  CSZ  to invoke the lisp ")
(princ)

HasanCAD

  • Swamp Rat
  • Posts: 1421
Re: Fresh eyes needed to check whats wrong
« Reply #4 on: February 01, 2015, 02:04:49 AM »
Judging by the number of unused variables and unnecessary code, I think you have pasted sections from an existing function...
Yes, I did. What I do is collecting sections of existing functions to create working lisp THen paste in the forum for professional colleagues to guide me to right way.

The code below works. But there is an important limitation. The dimensions for rectangular columns that are not orthogonal will be wrong.
Working as a charm.
Thanks Roy_043